1-- CD2A23A.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 OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT AFFECTED 29-- BY THE REPRESENTATION CLAUSE. 30 31-- HISTORY: 32-- RJW 07/28/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-- WMC 03/27/92 ELIMINATED TEST REDUNDANCIES. 37 38 39WITH REPORT; USE REPORT; 40WITH LENGTH_CHECK; -- CONTAINS A CALL TO 'FAILED'. 41PROCEDURE CD2A23A IS 42 43 BASIC_SIZE : CONSTANT := INTEGER'SIZE/2; 44 45 TYPE CHECK_TYPE IS (ZERO, ONE, TWO); 46 47 FOR CHECK_TYPE USE (ZERO => 3, ONE => 4, TWO => 5); 48 49 FOR CHECK_TYPE'SIZE USE BASIC_SIZE; 50 51 C0 : CHECK_TYPE := ZERO; 52 C1 : CHECK_TYPE := ONE; 53 C2 : CHECK_TYPE := TWO; 54 55 TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE; 56 CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO); 57 58 TYPE REC_TYPE IS RECORD 59 COMP0 : CHECK_TYPE := ZERO; 60 COMP1 : CHECK_TYPE := ONE; 61 COMP2 : CHECK_TYPE := TWO; 62 END RECORD; 63 64 CHREC : REC_TYPE; 65 66 FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS 67 BEGIN 68 IF EQUAL (3, 3) THEN 69 RETURN CH; 70 ELSE 71 RETURN ONE; 72 END IF; 73 END IDENT; 74 75 PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE); 76 77 PROCEDURE PROC (CI0, CI2 : CHECK_TYPE; 78 CIO1, CIO2 : IN OUT CHECK_TYPE; 79 CO2 : OUT CHECK_TYPE) IS 80 BEGIN 81 IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2) AND 82 (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN 83 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " & 84 "- 1"); 85 END IF; 86 87 IF CHECK_TYPE'VAL (0) /= IDENT (CI0) OR 88 CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR 89 CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN 90 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1"); 91 END IF; 92 93 IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0) OR 94 CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN 95 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1"); 96 END IF; 97 98 IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0) OR 99 CHECK_TYPE'VALUE ("ONE") /= IDENT (CIO1) OR 100 CHECK_TYPE'VALUE ("TWO") /= IDENT (CIO2) THEN 101 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1"); 102 END IF; 103 104 CO2 := TWO; 105 106 END PROC; 107 108BEGIN 109 TEST ("CD2A23A", "CHECK THAT WHEN A SIZE SPECIFICATION AND " & 110 "AN ENUMERATION REPRESENTATION CLAUSE ARE " & 111 "GIVEN FOR AN ENUMERATION TYPE, THEN " & 112 "OPERATIONS ON VALUES OF SUCH A TYPE ARE " & 113 "NOT AFFECTED BY THE REPRESENTATION CLAUSE"); 114 115 CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE"); 116 PROC (ZERO, TWO, C1, C2, C2); 117 118 IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN 119 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE"); 120 END IF; 121 122 IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN 123 FAILED ("INCORRECT VALUE FOR C0'SIZE"); 124 END IF; 125 126 IF NOT ((C0 < IDENT (ONE)) AND(IDENT (C2) > IDENT (C1)) AND 127 (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2)) THEN 128 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2"); 129 END IF; 130 131 IF CHECK_TYPE'LAST /= IDENT (TWO) THEN 132 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2"); 133 END IF; 134 135 IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR 136 CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR 137 CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN 138 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2"); 139 END IF; 140 141 IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR 142 CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN 143 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2"); 144 END IF; 145 146 IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR 147 CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE") OR 148 CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO") THEN 149 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2"); 150 END IF; 151 152 IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN 153 FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE"); 154 END IF; 155 156 IF NOT ((CHARRAY (0) < IDENT (ONE)) AND 157 (IDENT (CHARRAY (2)) > IDENT (CHARRAY (1))) AND 158 (CHARRAY (1) <= IDENT (ONE)) AND 159 (IDENT (TWO) = CHARRAY (2))) THEN 160 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3"); 161 END IF; 162 163 IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND 164 (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2))) THEN 165 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3"); 166 END IF; 167 168 IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR 169 CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR 170 CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN 171 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3"); 172 END IF; 173 174 IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR 175 CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN 176 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3"); 177 END IF; 178 179 IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR 180 CHECK_TYPE'VALUE ("ONE") /= IDENT (CHARRAY (1)) OR 181 CHECK_TYPE'VALUE ("TWO") /= IDENT (CHARRAY (2)) THEN 182 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3"); 183 END IF; 184 185 IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN 186 FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE"); 187 END IF; 188 189 IF NOT ((CHREC.COMP0 < IDENT (ONE)) AND 190 (IDENT (CHREC.COMP2) > IDENT (CHREC.COMP1)) AND 191 (CHREC.COMP1 <= IDENT (ONE)) AND 192 (IDENT (TWO) = CHREC.COMP2)) THEN 193 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4"); 194 END IF; 195 196 IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND 197 (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2)) THEN 198 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4"); 199 END IF; 200 201 IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR 202 CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR 203 CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN 204 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4"); 205 END IF; 206 207 IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR 208 CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN 209 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4"); 210 END IF; 211 212 IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR 213 CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE") OR 214 CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO") THEN 215 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4"); 216 END IF; 217 218 219 RESULT; 220 221END CD2A23A; 222