1-- CD2A23E.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 AND AN ENUMERATION 27-- REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE, 28-- THEN SUCH A TYPE CAN BE PASSED AS AN ACTUAL PARAMETER TO A 29-- GENERIC PROCEDURE. 30 31-- HISTORY: 32-- JET 08/18/87 CREATED ORIGINAL TEST. 33-- DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED 34-- OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON 35-- REPRESENTATION CLAUSE. 36-- BCB 03/05/90 ADDED CALL TO LENGTH_CHECK TO VERIFY THAT THE SIZE 37-- SPECIFICATION IS OBEYED. 38-- LDC 10/03/90 ADDED EXCEPTION HANDER FOR CHECK OF 'SUCC, 'PRED, 39-- ADDED CASES FOR >=, /=, ASSIGNMENT, QUALIFICATION, 40-- AND EXPLICIT CONVERSION. 41-- WMC 03/27/92 ELIMINATED TEST REDUNDANCIES. 42 43 44WITH REPORT; USE REPORT; 45WITH LENGTH_CHECK; -- CONTAINS A CALL TO 'FAILED'. 46PROCEDURE CD2A23E IS 47 48 TYPE BASIC_ENUM IS (ZERO, ONE, TWO); 49 BASIC_SIZE : CONSTANT := 8; 50 51 FOR BASIC_ENUM USE (ZERO => 3, ONE => 4, TWO => 5); 52 FOR BASIC_ENUM'SIZE USE BASIC_SIZE; 53 54BEGIN 55 TEST ("CD2A23E", "CHECK THAT WHEN A SIZE SPECIFICATION AND AN " & 56 "ENUMERATION REPRESENTATION CLAUSE ARE " & 57 "GIVEN FOR AN ENUMERATION TYPE, " & 58 "THEN SUCH A TYPE CAN BE " & 59 "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " & 60 "PROCEDURE"); 61 62 DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE. 63 64 GENERIC 65 TYPE GPARM IS (<>); 66 PROCEDURE GENPROC (C0, C1, C2: GPARM); 67 68 PROCEDURE GENPROC (C0, C1, C2: GPARM) IS 69 70 SUBTYPE CHECK_TYPE IS GPARM; 71 72 C3 : GPARM; 73 74 CHECKVAR : CHECK_TYPE; 75 76 FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS 77 BEGIN 78 IF EQUAL (3, 3) THEN 79 RETURN CH; 80 ELSE 81 RETURN C1; 82 END IF; 83 END IDENT; 84 85 PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE); 86 87 88 BEGIN -- GENPROC. 89 90 CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE"); 91 92 CHECKVAR := IDENT (C0); 93 94 CHECK_1 (CHECKVAR, CHECK_TYPE'SIZE, "CHECK_TYPE"); 95 96 IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN 97 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE"); 98 END IF; 99 100 IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN 101 FAILED ("INCORRECT VALUE FOR C0'SIZE"); 102 END IF; 103 104 IF NOT ((IDENT(C0) < IDENT (C1)) AND 105 (IDENT(C2) > IDENT (C1)) AND 106 (IDENT(C1) <= IDENT (C1)) AND 107 (IDENT(C2) = IDENT (C2))) THEN 108 FAILED ("INCORRECT RESULTS FOR RELATIONAL " & 109 "OPERATORS"); 110 END IF; 111 112 IF CHECK_TYPE'FIRST /= IDENT (C0) THEN 113 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST"); 114 END IF; 115 116 IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR 117 CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR 118 CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN 119 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS"); 120 END IF; 121 122 IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR 123 CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN 124 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC"); 125 END IF; 126 127 BEGIN 128 IF CHECK_TYPE'SUCC (IDENT(C2)) /= IDENT (C1) THEN 129 FAILED ("CONSTRAINT ERROR NOT RAISED FOR " & 130 "CHECK_TYPE'SUCC"); 131 END IF; 132 EXCEPTION 133 WHEN CONSTRAINT_ERROR => 134 IF 3 /= IDENT_INT(3) THEN 135 COMMENT ("DON'T OPTIMIZE EXCEPTION -1"); 136 END IF; 137 WHEN OTHERS => 138 FAILED ("WRONG EXCEPTION RAISED FOR " & 139 "CHECK_TYPE'SUCC"); 140 END; 141 142 BEGIN 143 IF CHECK_TYPE'PRED(IDENT(C0)) /= IDENT (C1) THEN 144 FAILED ("CONSTRAINT ERROR NOT RAISED FOR " & 145 "CHECK_TYPE'PRED"); 146 END IF; 147 EXCEPTION 148 WHEN CONSTRAINT_ERROR => 149 IF 3 /= IDENT_INT(3) THEN 150 COMMENT ("DON'T OPTIMIZE EXCEPTION -2"); 151 END IF; 152 WHEN OTHERS => 153 FAILED ("WRONG EXCEPTION RAISED FOR " & 154 "CHECK_TYPE'PRED"); 155 END; 156 157 IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR 158 CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN 159 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED"); 160 END IF; 161 162 IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR 163 CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE") OR 164 CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO") THEN 165 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE"); 166 END IF; 167 168 CHECKVAR := CHECK_TYPE'VALUE ("ONE"); 169 C3 := GPARM(CHECKVAR); 170 IF C3 /= IDENT(C1) THEN 171 FAILED ("INCORRECT VALUE FOR CONVERSION"); 172 END IF; 173 174 CHECK_1 (IDENT(C0), BASIC_SIZE, "CHECK_ENUM"); 175 176 177 IF CHECK_TYPE'(C2) /= IDENT(C2) THEN 178 FAILED ("INCORRECT VALUE FOR QUALIFICATION"); 179 END IF; 180 181 C3 := CHECK_TYPE'VALUE ("TWO"); 182 IF C3 /= IDENT(C2) THEN 183 FAILED ("INCORRECT VALUE FOR ASSIGNMENT"); 184 END IF; 185 186 END GENPROC; 187 188 PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM); 189 190 BEGIN 191 192 NEWPROC (ZERO, ONE, TWO); 193 194 END; 195 196 RESULT; 197 198END CD2A23E; 199