1-- C32107A.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-- CHECK THAT OBJECT DECLARATIONS ARE ELABORATED IN THE ORDER OF THEIR 26-- OCCURRENCE, I.E., THAT EXPRESSIONS ASSOCIATED WITH ONE DECLARATION 27-- (INCLUDING DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE EVALUATED BEFORE 28-- ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. ALSO, CHECK THAT 29-- EXPRESSIONS IN THE SUBTYPE INDICATION OR THE CONSTRAINED ARRAY 30-- DEFINITION ARE EVALUATED BEFORE ANY INITIALIZATION EXPRESSIONS ARE 31-- EVALUATED. 32 33-- R.WILLIAMS 9/24/86 34 35WITH REPORT; USE REPORT; 36PROCEDURE C32107A IS 37 38 BUMP : INTEGER := 0; 39 40 ORDER_CHECK : INTEGER; 41 42 G1, H1, I1 : INTEGER; 43 44 FIRST_CALL : BOOLEAN := TRUE; 45 46 TYPE ARR1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER; 47 48 TYPE ARR1_NAME IS ACCESS ARR1; 49 50 TYPE ARR2 IS ARRAY (POSITIVE RANGE <>, POSITIVE RANGE <>) OF 51 INTEGER; 52 53 TYPE REC (D : INTEGER) IS 54 RECORD 55 COMP : INTEGER; 56 END RECORD; 57 58 TYPE REC_NAME IS ACCESS REC; 59 60 FUNCTION F RETURN INTEGER IS 61 BEGIN 62 BUMP := BUMP + 1; 63 RETURN BUMP; 64 END F; 65 66 FUNCTION G RETURN INTEGER IS 67 BEGIN 68 BUMP := BUMP + 1; 69 G1 := BUMP; 70 RETURN BUMP; 71 END G; 72 73 FUNCTION H RETURN INTEGER IS 74 BEGIN 75 BUMP := BUMP + 1; 76 H1 := BUMP; 77 RETURN BUMP; 78 END H; 79 80 FUNCTION I RETURN INTEGER IS 81 BEGIN 82 IF FIRST_CALL THEN 83 BUMP := BUMP + 1; 84 I1 := BUMP; 85 FIRST_CALL := FALSE; 86 END IF; 87 RETURN I1; 88 END I; 89 90BEGIN 91 TEST ( "C32107A", "CHECK THAT OBJECT DECLARATIONS ARE " & 92 "ELABORATED IN THE ORDER OF THEIR " & 93 "OCCURRENCE, I.E., THAT EXPRESSIONS " & 94 "ASSOCIATED WITH ONE DECLARATION (INCLUDING " & 95 "DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE " & 96 "EVALUATED BEFORE ANY EXPRESSION BELONGING " & 97 "TO THE NEXT DECLARATION. ALSO, CHECK THAT " & 98 "EXPRESSIONS IN THE SUBTYPE INDICATION OR " & 99 "THE CONSTRAINED ARRAY DEFINITION ARE " & 100 "EVALUATED BEFORE ANY INITIALIZATION " & 101 "EXPRESSIONS ARE EVALUATED" ); 102 103 DECLARE -- (A). 104 I1 : INTEGER := 10000 * F; 105 A1 : CONSTANT ARRAY (1 .. H) OF REC (G * 100) := 106 (1 .. H1 => (G1 * 100, I * 10)); 107 I2 : CONSTANT INTEGER := F * 1000; 108 BEGIN 109 ORDER_CHECK := I1 + I2 + A1'LAST + A1 (1).D + A1 (1).COMP; 110 IF ORDER_CHECK = 15243 OR ORDER_CHECK = 15342 THEN 111 COMMENT ( "ORDER_CHECK HAS VALUE " & 112 INTEGER'IMAGE (ORDER_CHECK) & " - (A)" ); 113 ELSE 114 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 115 "VALUE OF ORDER_CHECK SHOULD BE 15343 OR " & 116 "15242 -- ACTUAL VALUE IS " & 117 INTEGER'IMAGE (ORDER_CHECK) & " - (A)" ); 118 END IF; 119 END; -- (A). 120 121 BUMP := 0; 122 123 DECLARE -- (B). 124 A : ARR2 (1 .. F, 1 .. F * 10); 125 R : REC (G * 100) := (G1 * 100, F * 1000); 126 I : INTEGER RANGE 1 .. H; 127 S : REC (F * 10); 128 BEGIN 129 ORDER_CHECK := 130 A'LAST (1) + A'LAST (2) + R.D + R.COMP; 131 IF (H1 + S.D = 65) AND 132 (ORDER_CHECK = 4321 OR ORDER_CHECK = 4312) THEN 133 COMMENT ( "ORDER_CHECK HAS VALUE 65 " & 134 INTEGER'IMAGE (ORDER_CHECK) & " - (B)" ); 135 ELSE 136 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 137 "VALUE OF ORDER_CHECK SHOULD BE 65 4321 OR " & 138 "65 4312 -- ACTUAL VALUE IS " & 139 INTEGER'IMAGE (H1 + S.D) & 140 INTEGER'IMAGE (ORDER_CHECK) & " - (B)" ); 141 END IF; 142 END; -- (B). 143 144 BUMP := 0; 145 146 DECLARE -- (C). 147 I1 : CONSTANT INTEGER RANGE 1 .. G * 10 := F; 148 A1 : ARRAY (1 .. F * 100) OF INTEGER RANGE 1 .. H * 1000; 149 BEGIN 150 ORDER_CHECK := I1 + (G1 * 10) + A1'LAST + (H1 * 1000); 151 IF ORDER_CHECK = 4312 OR ORDER_CHECK = 3412 THEN 152 COMMENT ( "ORDER_CHECK HAS VALUE " & 153 INTEGER'IMAGE (ORDER_CHECK) & " - (C)" ); 154 ELSE 155 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 156 "VALUE OF ORDER_CHECK SHOULD BE 4312 OR " & 157 "3412 -- ACTUAL VALUE IS " & 158 INTEGER'IMAGE (ORDER_CHECK) & " - (C)" ); 159 END IF; 160 END; -- (C). 161 162 BUMP := 0; 163 FIRST_CALL := TRUE; 164 165 DECLARE -- (D). 166 A1 : ARRAY (1 .. G) OF REC (H * 10000) := 167 (1 .. G1 => (H1 * 10000, I * 100)); 168 R1 : CONSTANT REC := (F * 1000, F * 10); 169 170 BEGIN 171 ORDER_CHECK := 172 A1'LAST + A1 (1).D + A1 (1).COMP + R1.D + R1.COMP; 173 IF ORDER_CHECK = 25341 OR ORDER_CHECK = 24351 OR 174 ORDER_CHECK = 15342 OR ORDER_CHECK = 14352 THEN 175 COMMENT ( "ORDER_CHECK HAS VALUE " & 176 INTEGER'IMAGE (ORDER_CHECK) & " - (D)" ); 177 ELSE 178 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 179 "VALUE OF ORDER_CHECK SHOULD BE 25341, " & 180 "24351, 15342 OR 14352 -- ACTUAL VALUE IS " & 181 INTEGER'IMAGE (ORDER_CHECK) & " - (D)" ); 182 END IF; 183 END; -- (D). 184 185 BUMP := 0; 186 187 DECLARE -- (E). 188 A1 : CONSTANT ARR1_NAME := NEW ARR1' (1 .. F => F * 10); 189 R1 : REC_NAME (H * 100) := NEW REC'(H1 * 100, F * 1000); 190 191 BEGIN 192 ORDER_CHECK := A1.ALL'LAST + A1.ALL (1) + R1.D + R1.COMP; 193 IF ORDER_CHECK /= 4321 THEN 194 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 195 "VALUE OF ORDER_CHECK SHOULD BE 4321 " & 196 "-- ACTUAL VALUE IS " & 197 INTEGER'IMAGE (ORDER_CHECK) & " - (E)" ); 198 END IF; 199 END; -- (E). 200 201 BUMP := 0; 202 FIRST_CALL := TRUE; 203 204 DECLARE -- (F). 205 A1 : CONSTANT ARRAY (1 .. G) OF INTEGER RANGE 1 .. H * 100 := 206 (1 .. G1 => I * 10); 207 A2 : ARR1 (1 .. F * 1000); 208 BEGIN 209 ORDER_CHECK := 210 A1'LAST + (H1 * 100) + A1 (1) + A2'LAST; 211 IF ORDER_CHECK = 4231 OR ORDER_CHECK = 4132 THEN 212 COMMENT ( "ORDER_CHECK HAS VALUE " & 213 INTEGER'IMAGE (ORDER_CHECK) & " - (F)" ); 214 ELSE 215 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 216 "VALUE OF ORDER_CHECK SHOULD BE 4231 OR " & 217 "4132 -- ACTUAL VALUE IS " & 218 INTEGER'IMAGE (ORDER_CHECK) & " - (F)" ); 219 END IF; 220 END; -- (F). 221 222 BUMP := 0; 223 224 DECLARE -- (G). 225 A1 : ARR1_NAME (1 .. G) := NEW ARR1 (1 .. G1); 226 R1 : CONSTANT REC_NAME (H * 10) := 227 NEW REC'(H1 * 10, F * 100); 228 BEGIN 229 ORDER_CHECK := A1.ALL'LAST + R1.D + R1.COMP; 230 IF ORDER_CHECK /= 321 THEN 231 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 232 "VALUE OF ORDER_CHECK SHOULD BE 321 OR " & 233 "-- ACTUAL VALUE IS " & 234 INTEGER'IMAGE (ORDER_CHECK) & " - (G)" ); 235 END IF; 236 END; -- (G). 237 238 BUMP := 0; 239 240 DECLARE -- (H). 241 TYPE REC (D : INTEGER := F) IS 242 RECORD 243 COMP : INTEGER := F * 10; 244 END RECORD; 245 246 R1 : REC; 247 R2 : REC (G * 100) := (G1 * 100, F * 1000); 248 BEGIN 249 ORDER_CHECK := R1.D + R1.COMP + R2.D + R2.COMP; 250 IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR 251 ORDER_CHECK = 3421 OR ORDER_CHECK = 3412 THEN 252 COMMENT ( "ORDER_CHECK HAS VALUE " & 253 INTEGER'IMAGE (ORDER_CHECK) & " - (H)" ); 254 ELSE 255 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 256 "VALUE OF ORDER_CHECK SHOULD BE 4321, " & 257 "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & 258 INTEGER'IMAGE (ORDER_CHECK) & " - (H)" ); 259 END IF; 260 END; -- (H). 261 262 BUMP := 0; 263 264 DECLARE -- (I). 265 TYPE REC2 (D1, D2 : INTEGER) IS 266 RECORD 267 COMP : INTEGER; 268 END RECORD; 269 270 R1 : REC2 (G * 1000, H * 10000) := 271 (G1 * 1000, H1 * 10000, F * 100); 272 R2 : REC2 (F, F * 10); 273 BEGIN 274 ORDER_CHECK := R1.D1 + R1.D2 + R1.COMP + R2.D1 + R2.D2; 275 IF ORDER_CHECK = 21354 OR ORDER_CHECK = 21345 OR 276 ORDER_CHECK = 12345 OR ORDER_CHECK = 12354 THEN 277 COMMENT ( "ORDER_CHECK HAS VALUE " & 278 INTEGER'IMAGE (ORDER_CHECK) & " - (I)" ); 279 ELSE 280 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 281 "VALUE OF ORDER_CHECK SHOULD BE 21354, " & 282 "21345, 12354, OR 12345 -- ACTUAL VALUE IS " & 283 INTEGER'IMAGE (ORDER_CHECK) & " - (I)" ); 284 END IF; 285 286 END; -- (I). 287 288 BUMP := 0; 289 290 DECLARE -- (J). 291 PACKAGE P IS 292 TYPE PRIV (D : INTEGER) IS PRIVATE; 293 294 P1 : CONSTANT PRIV; 295 P2 : CONSTANT PRIV; 296 297 FUNCTION GET_A (P : PRIV) RETURN INTEGER; 298 PRIVATE 299 TYPE PRIV (D : INTEGER) IS 300 RECORD 301 COMP : INTEGER; 302 END RECORD; 303 P1 : CONSTANT PRIV := (F , F * 10); 304 P2 : CONSTANT PRIV := (F * 100, F * 1000); 305 END P; 306 307 PACKAGE BODY P IS 308 FUNCTION GET_A (P : PRIV) RETURN INTEGER IS 309 BEGIN 310 RETURN P.COMP; 311 END GET_A; 312 END P; 313 314 USE P; 315 BEGIN 316 ORDER_CHECK := P1.D + GET_A (P1) + P2.D + GET_A (P2); 317 IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR 318 ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN 319 COMMENT ( "ORDER_CHECK HAS VALUE " & 320 INTEGER'IMAGE (ORDER_CHECK) & " - (J)" ); 321 ELSE 322 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 323 "VALUE OF ORDER_CHECK SHOULD BE 4321, " & 324 "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & 325 INTEGER'IMAGE (ORDER_CHECK) & " - (J)" ); 326 END IF; 327 END; -- (J). 328 329 BUMP := 0; 330 331 DECLARE -- (K). 332 PACKAGE P IS 333 TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE; 334 335 PRIVATE 336 TYPE PRIV (D1, D2 : INTEGER) IS 337 RECORD 338 NULL; 339 END RECORD; 340 END P; 341 342 USE P; 343 344 P1 : PRIV (F, F * 10); 345 P2 : PRIV (F * 100, F * 1000); 346 347 BEGIN 348 ORDER_CHECK := P1.D1 + P1.D2 + P2.D1 + P2.D2; 349 IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR 350 ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN 351 COMMENT ( "ORDER_CHECK HAS VALUE " & 352 INTEGER'IMAGE (ORDER_CHECK) & " - (K)" ); 353 ELSE 354 FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & 355 "VALUE OF ORDER_CHECK SHOULD BE 4321, 4312, " & 356 "3421, OR 3412 -- ACTUAL VALUE IS " & 357 INTEGER'IMAGE (ORDER_CHECK) & " - (K)" ); 358 END IF; 359 360 END; -- (K). 361 362 RESULT; 363END C32107A; 364