-- 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;