1-- CD2A24A.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 WITH THE SMALLEST 29-- APPROPRIATE SIGNED SIZE ARE NOT AFFECTED BY THE 30-- REPRESENTATION CLAUSE. 31 32-- HISTORY: 33-- JET 08/19/87 CREATED ORIGINAL TEST. 34-- DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED 35-- OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON 36-- REPRESENTATION CLAUSE. 37-- WMC 03/27/92 ELIMINATED TEST REDUNDANCIES. 38 39WITH REPORT; USE REPORT; 40WITH LENGTH_CHECK; -- CONTAINS A CALL TO 'FAILED'. 41PROCEDURE CD2A24A IS 42 43 BASIC_SIZE : CONSTANT := 4; 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 ("CD2A24A", "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 WITH " & 113 "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " & 114 "NOT AFFECTED BY THE REPRESENTATION CLAUSE"); 115 116 CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE"); 117 PROC (ZERO, TWO, C1, C2, C2); 118 119 IF C1 /= ONE OR C2 /= TWO THEN 120 FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE"); 121 END IF; 122 123 IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN 124 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE"); 125 END IF; 126 127 IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN 128 FAILED ("INCORRECT VALUE FOR C0'SIZE"); 129 END IF; 130 131 IF NOT ((C0 < IDENT (ONE)) AND(IDENT (C2) > IDENT (C1)) AND 132 (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2)) THEN 133 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2"); 134 END IF; 135 136 IF CHECK_TYPE'LAST /= IDENT (TWO) THEN 137 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2"); 138 END IF; 139 140 IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR 141 CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR 142 CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN 143 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2"); 144 END IF; 145 146 IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR 147 CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN 148 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2"); 149 END IF; 150 151 IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR 152 CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE") OR 153 CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO") THEN 154 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2"); 155 END IF; 156 157 IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN 158 FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE"); 159 END IF; 160 161 IF NOT ((CHARRAY (0) < IDENT (ONE)) AND 162 (IDENT (CHARRAY (2)) > IDENT (CHARRAY (1))) AND 163 (CHARRAY (1) <= IDENT (ONE)) AND 164 (IDENT (TWO) = CHARRAY (2))) THEN 165 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3"); 166 END IF; 167 168 IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND 169 (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2))) THEN 170 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3"); 171 END IF; 172 173 IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR 174 CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR 175 CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN 176 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3"); 177 END IF; 178 179 IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR 180 CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN 181 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3"); 182 END IF; 183 184 IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR 185 CHECK_TYPE'VALUE ("ONE") /= IDENT (CHARRAY (1)) OR 186 CHECK_TYPE'VALUE ("TWO") /= IDENT (CHARRAY (2)) THEN 187 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3"); 188 END IF; 189 190 IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN 191 FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE"); 192 END IF; 193 194 IF NOT ((CHREC.COMP0 < IDENT (ONE)) AND 195 (IDENT (CHREC.COMP2) > IDENT (CHREC.COMP1)) AND 196 (CHREC.COMP1 <= IDENT (ONE)) AND 197 (IDENT (TWO) = CHREC.COMP2)) THEN 198 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4"); 199 END IF; 200 201 IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND 202 (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2)) THEN 203 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4"); 204 END IF; 205 206 IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR 207 CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR 208 CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN 209 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4"); 210 END IF; 211 212 IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR 213 CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN 214 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4"); 215 END IF; 216 217 IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR 218 CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE") OR 219 CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO") THEN 220 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4"); 221 END IF; 222 223 224 RESULT; 225 226END CD2A24A; 227