1-- CD2A32J.ADA 2 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- OBJECTIVE: 26-- CHECK THAT WHEN A SIZE SPECIFICATION OF THE SMALLEST APPROPRIATE 27-- UNSIGNED SIZE IS GIVEN FOR AN INTEGER TYPE, THE TYPE CAN BE 28-- PASSED AS AN ACTUAL PARAMETER TO GENERIC PROCEDURES. 29 30-- HISTORY: 31-- JET 08/12/87 CREATED ORIGINAL TEST. 32-- DHH 04/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED 33-- SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON 34-- 'SIZE CHECKS. 35-- JRL 03/27/92 ELIMINATED REDUNDANT TESTING. 36 37WITH REPORT; USE REPORT; 38 39PROCEDURE CD2A32J IS 40 41 TYPE BASIC_INT IS RANGE 0 .. 126; 42 BASIC_SIZE : CONSTANT := 7; 43 44 FOR BASIC_INT'SIZE USE BASIC_SIZE; 45 46BEGIN 47 48 TEST ("CD2A32J", "CHECK THAT WHEN A SIZE SPECIFICATION " & 49 "OF THE SMALLEST APPROPRIATE UNSIGNED SIZE " & 50 "IS GIVEN FOR AN INTEGER TYPE, THE TYPE " & 51 "CAN BE PASSED AS AN ACTUAL PARAMETER TO " & 52 "GENERIC PROCEDURES"); 53 54 DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE. 55 56 GENERIC 57 TYPE GPARM IS RANGE <>; 58 PROCEDURE GENPROC; 59 60 PROCEDURE GENPROC IS 61 62 SUBTYPE INT IS GPARM; 63 64 I0 : INT := 0; 65 I1 : INT := 63; 66 I2 : INT := 126; 67 68 FUNCTION IDENT (I : INT) RETURN INT IS 69 BEGIN 70 IF EQUAL (0,0) THEN 71 RETURN I; 72 ELSE 73 RETURN 0; 74 END IF; 75 END IDENT; 76 77 BEGIN -- GENPROC. 78 79 IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN 80 FAILED ("INCORRECT VALUE FOR INT'SIZE"); 81 END IF; 82 83 IF I0'SIZE < IDENT_INT (BASIC_SIZE) THEN 84 FAILED ("INCORRECT VALUE FOR I0'SIZE"); 85 END IF; 86 87 IF NOT ((I0 < IDENT (1)) AND 88 (IDENT (I2) > IDENT (I1)) AND 89 (I1 <= IDENT (63)) AND 90 (IDENT (126) = I2)) THEN 91 FAILED ("INCORRECT RESULTS FOR RELATIONAL " & 92 "OPERATORS"); 93 END IF; 94 95 IF NOT (((I0 + I2) = I2) AND 96 ((I2 - I1) = I1) AND 97 ((I1 * IDENT (2)) = I2) AND 98 ((I2 / I1) = IDENT (2)) AND 99 ((I1 ** 1) = IDENT (63)) AND 100 ((I2 REM 10) = IDENT (6)) AND 101 ((I1 MOD 10) = IDENT (3))) THEN 102 FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " & 103 "OPERATORS"); 104 END IF; 105 106 IF INT'POS (I0) /= IDENT_INT (0) OR 107 INT'POS (I1) /= IDENT_INT (63) OR 108 INT'POS (I2) /= IDENT_INT (126) THEN 109 FAILED ("INCORRECT VALUE FOR INT'POS"); 110 END IF; 111 112 IF INT'SUCC (I0) /= IDENT (1) OR 113 INT'SUCC (I1) /= IDENT (64) THEN 114 FAILED ("INCORRECT VALUE FOR INT'SUCC"); 115 END IF; 116 117 IF INT'IMAGE (I0) /= IDENT_STR (" 0") OR 118 INT'IMAGE (I1) /= IDENT_STR (" 63") OR 119 INT'IMAGE (I2) /= IDENT_STR (" 126") THEN 120 FAILED ("INCORRECT VALUE FOR INT'IMAGE"); 121 END IF; 122 123 END GENPROC; 124 125 PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT); 126 127 BEGIN 128 129 NEWPROC; 130 131 END; 132 133 RESULT; 134 135END CD2A32J; 136