URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c32107a.ada] - Blame information for rev 12

Details | Compare with Previous | View Log


-- C32107A.ADA
 
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- CHECK THAT OBJECT DECLARATIONS ARE ELABORATED IN THE ORDER OF THEIR 
-- OCCURRENCE, I.E., THAT EXPRESSIONS ASSOCIATED WITH ONE DECLARATION
-- (INCLUDING DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE EVALUATED BEFORE
-- ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. ALSO, CHECK THAT
-- EXPRESSIONS IN THE SUBTYPE INDICATION OR THE CONSTRAINED ARRAY 
-- DEFINITION ARE EVALUATED BEFORE ANY INITIALIZATION EXPRESSIONS ARE
-- EVALUATED.
 
-- R.WILLIAMS 9/24/86
 
WITH REPORT; USE REPORT;
PROCEDURE C32107A IS
 
     BUMP : INTEGER := 0;
 
     ORDER_CHECK : INTEGER;
 
     G1, H1, I1 : INTEGER;
 
     FIRST_CALL : BOOLEAN := TRUE;
 
     TYPE ARR1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
 
     TYPE ARR1_NAME IS ACCESS ARR1;
 
     TYPE ARR2 IS ARRAY (POSITIVE RANGE <>, POSITIVE RANGE <>) OF
          INTEGER;
 
     TYPE REC (D : INTEGER) IS
          RECORD
               COMP : INTEGER;
          END RECORD;
 
     TYPE REC_NAME IS ACCESS REC;
 
     FUNCTION F RETURN INTEGER IS
     BEGIN
          BUMP := BUMP + 1;
          RETURN BUMP;
     END F;
 
     FUNCTION G RETURN INTEGER IS
     BEGIN
          BUMP := BUMP + 1;
          G1 := BUMP;
          RETURN BUMP;
     END G;
 
     FUNCTION H RETURN INTEGER IS
     BEGIN
          BUMP := BUMP + 1;
          H1 := BUMP;
          RETURN BUMP;
     END H;
 
     FUNCTION I RETURN INTEGER IS
     BEGIN
          IF FIRST_CALL THEN
               BUMP := BUMP + 1;
               I1 := BUMP;
               FIRST_CALL := FALSE;
          END IF;
          RETURN I1;
     END I;
 
BEGIN
     TEST ( "C32107A", "CHECK THAT OBJECT DECLARATIONS ARE " &
                       "ELABORATED IN THE ORDER OF THEIR " &
                       "OCCURRENCE, I.E., THAT EXPRESSIONS " &
                       "ASSOCIATED WITH ONE DECLARATION (INCLUDING " &
                       "DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE " &
                       "EVALUATED BEFORE ANY EXPRESSION BELONGING " &
                       "TO THE NEXT DECLARATION.  ALSO, CHECK THAT " &
                       "EXPRESSIONS IN THE SUBTYPE INDICATION OR " &
                       "THE CONSTRAINED ARRAY DEFINITION ARE " &
                       "EVALUATED BEFORE ANY INITIALIZATION " &
                       "EXPRESSIONS ARE EVALUATED" );
 
     DECLARE -- (A).
          I1 : INTEGER := 10000 * F;
          A1 : CONSTANT ARRAY (1 .. H) OF REC (G * 100) :=
               (1 .. H1 => (G1 * 100, I * 10));
          I2 : CONSTANT INTEGER := F * 1000;
     BEGIN
          ORDER_CHECK := I1 + I2 + A1'LAST + A1 (1).D + A1 (1).COMP;
          IF ORDER_CHECK = 15243 OR ORDER_CHECK = 15342 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 15343 OR " &
                        "15242 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
          END IF;
     END; -- (A).         
 
     BUMP := 0;
 
     DECLARE -- (B).
          A : ARR2 (1 .. F, 1 .. F * 10);
          R : REC (G * 100) := (G1 * 100, F * 1000);
          I : INTEGER RANGE 1 .. H;
          S : REC (F * 10);
     BEGIN
          ORDER_CHECK :=
               A'LAST (1) + A'LAST (2) + R.D + R.COMP;
          IF (H1 + S.D = 65) AND
             (ORDER_CHECK = 4321 OR ORDER_CHECK = 4312) THEN
               COMMENT ( "ORDER_CHECK HAS VALUE 65 " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 65 4321 OR " &
                        "65 4312 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (H1 + S.D) &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
          END IF;
     END; -- (B).         
 
     BUMP := 0;
 
     DECLARE -- (C).
          I1 : CONSTANT INTEGER RANGE 1 .. G * 10 := F;
          A1 : ARRAY (1 .. F * 100) OF INTEGER RANGE 1 .. H * 1000;
     BEGIN
          ORDER_CHECK := I1 + (G1 * 10) + A1'LAST + (H1 * 1000);
          IF ORDER_CHECK = 4312 OR ORDER_CHECK = 3412 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 4312 OR " &
                        "3412 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
          END IF;
     END; -- (C).         
 
     BUMP := 0;
     FIRST_CALL := TRUE;
 
     DECLARE -- (D).
          A1 : ARRAY (1 .. G) OF REC (H * 10000) :=
               (1 .. G1 => (H1 * 10000, I * 100));
          R1 : CONSTANT REC := (F * 1000, F * 10);
 
     BEGIN
          ORDER_CHECK :=
               A1'LAST + A1 (1).D + A1 (1).COMP + R1.D + R1.COMP;
          IF ORDER_CHECK = 25341 OR ORDER_CHECK = 24351 OR
             ORDER_CHECK = 15342 OR ORDER_CHECK = 14352 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 25341, " &
                        "24351, 15342 OR 14352  -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
          END IF;
     END; -- (D).         
 
     BUMP := 0;
 
     DECLARE -- (E).
          A1 : CONSTANT ARR1_NAME := NEW ARR1' (1 .. F => F * 10);
          R1 : REC_NAME (H * 100) := NEW REC'(H1 * 100, F * 1000);
 
     BEGIN
          ORDER_CHECK := A1.ALL'LAST + A1.ALL (1) + R1.D + R1.COMP;
          IF ORDER_CHECK /= 4321 THEN
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 4321 " &
                        "-- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (E)" );
          END IF;
     END; -- (E).         
 
     BUMP := 0;
     FIRST_CALL := TRUE;
 
     DECLARE -- (F).
          A1 : CONSTANT ARRAY (1 .. G) OF INTEGER RANGE 1 .. H * 100 :=
               (1 .. G1 => I * 10);
          A2 : ARR1 (1 .. F * 1000);
     BEGIN
          ORDER_CHECK :=
               A1'LAST + (H1 * 100) + A1 (1) + A2'LAST;
          IF ORDER_CHECK = 4231 OR ORDER_CHECK = 4132 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 4231 OR " &
                        "4132 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
          END IF;
     END; -- (F).         
 
     BUMP := 0;
 
     DECLARE -- (G).
          A1 : ARR1_NAME (1 .. G) := NEW ARR1 (1 .. G1);
          R1 : CONSTANT REC_NAME (H * 10) :=
               NEW REC'(H1 * 10, F * 100);
     BEGIN
          ORDER_CHECK := A1.ALL'LAST + R1.D + R1.COMP;
          IF ORDER_CHECK /= 321 THEN
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 321 OR " &
                        "-- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (G)" );
          END IF;
     END; -- (G).         
 
     BUMP := 0;
 
     DECLARE -- (H). 
          TYPE REC (D : INTEGER := F) IS
               RECORD
                    COMP : INTEGER := F * 10;
               END RECORD;
 
          R1 : REC;
          R2 : REC (G * 100) := (G1 * 100, F * 1000);
     BEGIN
          ORDER_CHECK := R1.D + R1.COMP + R2.D + R2.COMP;
          IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
             ORDER_CHECK = 3421 OR ORDER_CHECK = 3412 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
                        "4312, 3421, OR 3412 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
          END IF;
     END; -- (H).         
 
     BUMP := 0;
 
     DECLARE -- (I).
          TYPE REC2 (D1, D2 : INTEGER) IS
               RECORD
                    COMP : INTEGER;
               END RECORD;
 
          R1 : REC2 (G  * 1000, H  * 10000) :=
                    (G1 * 1000, H1 * 10000, F * 100);
          R2 : REC2 (F, F * 10);
     BEGIN
          ORDER_CHECK := R1.D1 + R1.D2 + R1.COMP + R2.D1 + R2.D2;
          IF ORDER_CHECK = 21354 OR ORDER_CHECK = 21345 OR
             ORDER_CHECK = 12345 OR ORDER_CHECK = 12354 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 21354, " &
                        "21345, 12354, OR 12345 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
          END IF;
 
     END; -- (I).         
 
     BUMP := 0;
 
     DECLARE -- (J).
          PACKAGE P IS
               TYPE PRIV (D : INTEGER) IS PRIVATE;
 
               P1 : CONSTANT PRIV;
               P2 : CONSTANT PRIV;
 
               FUNCTION GET_A (P : PRIV) RETURN INTEGER;
          PRIVATE
               TYPE PRIV (D : INTEGER) IS
                    RECORD
                         COMP : INTEGER;
                    END RECORD;
               P1 : CONSTANT PRIV := (F , F * 10);
               P2 : CONSTANT PRIV := (F * 100, F * 1000);
          END P;
 
          PACKAGE BODY P IS
               FUNCTION GET_A (P : PRIV) RETURN INTEGER IS
               BEGIN
                    RETURN P.COMP;
               END GET_A;
          END P;
 
          USE P;
     BEGIN
          ORDER_CHECK := P1.D + GET_A (P1) + P2.D + GET_A (P2);
          IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
             ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
                        "4312, 3421, OR 3412 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
          END IF;
     END; -- (J).         
 
     BUMP := 0;
 
     DECLARE -- (K).
          PACKAGE P IS
               TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE;
 
          PRIVATE
               TYPE PRIV (D1, D2 : INTEGER) IS
                    RECORD
                         NULL;
                    END RECORD;
          END P;
 
          USE P;
 
          P1 : PRIV (F, F * 10);
          P2 : PRIV (F * 100, F * 1000);
 
     BEGIN
          ORDER_CHECK := P1.D1 + P1.D2 + P2.D1 + P2.D2;
          IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
             ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
               COMMENT ( "ORDER_CHECK HAS VALUE " &
                          INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
          ELSE
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
                        "VALUE OF ORDER_CHECK SHOULD BE 4321, 4312, " &
                        "3421, OR 3412 -- ACTUAL VALUE IS " &
                         INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
          END IF;
 
     END; -- (K).         
 
     RESULT;
END C32107A;

Browse

Tools

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c32107a.ada] - Blame information for rev 12

Line No.	Rev	Author	Line
1	12	jlechner	`-- 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
35			`WITH REPORT; USE REPORT;`
36			`PROCEDURE 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
90			`BEGIN`
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;`
363			`END C32107A;`