llvm-gcc-4.2/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada

-- CC3016C.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 AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
--  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
--  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
--  DECLARATIONS (IN SPEC AND IN BODY).

-- HISTORY:
--         EDWARD V. BERARD, 8 AUGUST 1990

WITH REPORT;

PROCEDURE  CC3016C  IS

    GENERIC
    
        TYPE SOME_TYPE IS PRIVATE ;
        FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
        SECOND_INITIAL_VALUE : IN SOME_TYPE ;
        WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
                               RESULT : OUT SOME_TYPE) ;
        WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
                                      RESULT : OUT SOME_TYPE) ;
        WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
                                     RESULT : OUT SOME_TYPE) ;
        FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
        SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
        THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
        FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
        FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
        SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
    
    PACKAGE OUTER IS

        VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
        
        FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;

        GENERIC
        
            INITIAL_VALUE : IN SOME_TYPE ;
            WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
                                   RESULT : OUT SOME_TYPE) ;
            WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
                                          RESULT : OUT SOME_TYPE) ;
            FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
            SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
            THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
            FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
                    
        PACKAGE INNER  IS
            VARIABLE : SOME_TYPE := INITIAL_VALUE ;
        END INNER ;
        
    END OUTER ;


    PACKAGE BODY OUTER IS

        ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
        
        PACKAGE BODY  INNER  IS
            ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
        BEGIN  -- INNER

            CHANGE (FIRST  => VARIABLE,
                    RESULT => VARIABLE) ;
            CHANGE (FIRST  => ANOTHER_VARIABLE,
                    RESULT => ANOTHER_VARIABLE) ;
            OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
                                 RESULT => OUTER.VARIABLE) ;
            OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
                          RESULT => OUTER.ANOTHER_VARIABLE) ;

            IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
               (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
               (OUTER.VARIABLE 
                       /= THIRD_EXPECTED_RESULT) OR
               (OUTER.ANOTHER_VARIABLE 
                       /= FOURTH_EXPECTED_RESULT) THEN
                    REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
            END IF;

        END INNER ;

        PACKAGE NEW_INNER IS NEW INNER 
            (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
             CHANGE                 => CHANGE,
             SECOND_CHANGE          => THIRD_CHANGE,
             FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
             SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
             THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
             FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
             
        FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
        BEGIN
            RETURN NEW_INNER.VARIABLE ;            
        END INNER_VARIABLE ;

    BEGIN  -- OUTER
    
        SECOND_CHANGE (FIRST  => VARIABLE,
                       RESULT => VARIABLE) ;
        SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
                       RESULT => ANOTHER_VARIABLE) ;
                       
        IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
           (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
           (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
            REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
        END IF;

    END OUTER ;
    
    PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
                      GIVING_THIS_RESULT  : OUT INTEGER) IS
    BEGIN -- DOUBLE
        GIVING_THIS_RESULT := 2 * THIS_VALUE ;
    END DOUBLE ;
    
    PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
                      GIVING_THIS_RESULT : OUT INTEGER) IS
    BEGIN -- ADD_20
        GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
    END ADD_20 ;
    
    PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
                          GIVING_THIS_RESULT  : OUT INTEGER) IS
    BEGIN -- TIMES_FIVE
        GIVING_THIS_RESULT := 5 * THIS_VALUE ;
    END TIMES_FIVE ;    
    
BEGIN -- CC3016C

    REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
                 "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
                 "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
                 "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
                   
    LOCAL_BLOCK:
    
    DECLARE
    
        PACKAGE NEW_OUTER IS NEW OUTER
            (SOME_TYPE                 => INTEGER,
            FIRST_INITIAL_VALUE        => 7,
            SECOND_INITIAL_VALUE       => 11,
            CHANGE                     => DOUBLE,
            SECOND_CHANGE              => ADD_20,
            THIRD_CHANGE               => TIMES_FIVE,
            FIRST_EXPECTED_RESULT      => 22, 
            SECOND_EXPECTED_RESULT     => 22,
            THIRD_EXPECTED_RESULT      => 27,
            FOURTH_EXPECTED_RESULT     => 14,
            FIFTH_EXPECTED_RESULT      => 47,
            SIXTH_EXPECTED_RESULT      => 34) ;

    BEGIN  -- LOCAL_BLOCK    
    
        IF (NEW_OUTER.VARIABLE /= 47) OR
           (NEW_OUTER.INNER_VARIABLE /= 22) THEN
            REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
                          "BODY OF MAIN PROGRAM") ;
        END IF;
        
    END LOCAL_BLOCK ;

    REPORT.RESULT;

END CC3016C;