diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada | 224 |
1 files changed, 224 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada new file mode 100644 index 000000000..eef77fde9 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada @@ -0,0 +1,224 @@ +-- C74209A.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 OUTSIDE A PACKAGE WHICH DEFINES PRIVATE TYPES AND LIMITED +-- PRIVATE TYPES IT IS POSSIBLE TO DECLARE SUBPROGRAMS WHICH USE +-- THOSE TYPES AS TYPES FOR PARAMETERS (OF ANY MODE EXCEPT OUT FOR A +-- LIMITED TYPE) OR AS THE TYPE FOR THE RESULT (FOR FUNCTION +-- SUBPROGRAMS). + +-- RM 07/14/81 + + +WITH REPORT; +PROCEDURE C74209A IS + + USE REPORT; + +BEGIN + + TEST( "C74209A" , "CHECK THAT PROCEDURE SIGNATURES CAN USE " & + "PRIVATE TYPES" ); + + DECLARE + + PACKAGE PACK IS + + TYPE LIM_PRIV IS LIMITED PRIVATE; + TYPE PRIV IS PRIVATE; + PRIV_CONST_IN : CONSTANT PRIV; + PRIV_CONST_OUT : CONSTANT PRIV; + FUNCTION PACKAGED( X: IN INTEGER ) RETURN LIM_PRIV; + FUNCTION EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN ; + PROCEDURE ASSIGN( X : IN LIM_PRIV; Y : OUT LIM_PRIV ); + + PRIVATE + + TYPE LIM_PRIV IS NEW INTEGER; + TYPE PRIV IS NEW STRING( 1..5 ); + PRIV_CONST_IN : CONSTANT PRIV := "ABCDE"; + PRIV_CONST_OUT : CONSTANT PRIV := "FGHIJ"; + + END PACK; + + + PRIV_VAR_1 , PRIV_VAR_2 : PACK.PRIV; + LIM_PRIV_VAR_1 , LIM_PRIV_VAR_2 : PACK.LIM_PRIV; + + + USE PACK; + + + PACKAGE BODY PACK IS + + FUNCTION PACKAGED( X: IN INTEGER ) RETURN LIM_PRIV IS + BEGIN + RETURN LIM_PRIV(X); + END PACKAGED; + + FUNCTION EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN IS + BEGIN + RETURN X = Y ; + END EQUALS; + + PROCEDURE ASSIGN( X : IN LIM_PRIV; Y : OUT LIM_PRIV) IS + BEGIN + Y := X; + END ASSIGN; + + END PACK; + + + PROCEDURE PROC1( X : IN OUT PACK.PRIV; + Y : IN PACK.PRIV := PACK.PRIV_CONST_IN; + Z : OUT PACK.PRIV; + U : PACK.PRIV ) IS + BEGIN + + IF X /= PACK.PRIV_CONST_IN OR + Y /= PACK.PRIV_CONST_IN OR + U /= PACK.PRIV_CONST_IN + THEN + FAILED( "WRONG INPUT VALUES - PROC1" ); + END IF; + + X := PACK.PRIV_CONST_OUT; + Z := PACK.PRIV_CONST_OUT; + + END PROC1; + + + PROCEDURE PROC2( X : IN OUT LIM_PRIV; + Y : IN LIM_PRIV; + Z : IN OUT LIM_PRIV; + U : LIM_PRIV ) IS + BEGIN + + IF NOT(EQUALS( X , PACKAGED(17) )) OR + NOT(EQUALS( Y , PACKAGED(17) )) OR + NOT(EQUALS( U , PACKAGED(17) )) + THEN + FAILED( "WRONG INPUT VALUES - PROC2" ); + END IF; + + ASSIGN( PACKAGED(13) , X ); + ASSIGN( PACKAGED(13) , Z ); + + END PROC2; + + + FUNCTION FUNC1( Y : IN PRIV := PRIV_CONST_IN; + U : PRIV ) RETURN PRIV IS + BEGIN + + IF Y /= PRIV_CONST_IN OR + U /= PRIV_CONST_IN + THEN + FAILED( "WRONG INPUT VALUES - FUNC1" ); + END IF; + + RETURN PRIV_CONST_OUT; + + END FUNC1; + + + FUNCTION FUNC2( Y : IN LIM_PRIV; + U : LIM_PRIV ) RETURN LIM_PRIV IS + BEGIN + + IF NOT(EQUALS( Y , PACKAGED(17) )) OR + NOT(EQUALS( U , PACKAGED(17) )) + THEN + FAILED( "WRONG INPUT VALUES - FUNC2" ); + END IF; + + RETURN PACKAGED(13); + + END FUNC2; + + + BEGIN + + -------------------------------------------------------------- + + PRIV_VAR_1 := PRIV_CONST_IN; + PRIV_VAR_2 := PRIV_CONST_IN; + + PROC1( PRIV_VAR_1 , Z => PRIV_VAR_2 , U => PRIV_CONST_IN ); + + IF PRIV_VAR_1 /= PACK.PRIV_CONST_OUT OR + PRIV_VAR_2 /= PACK.PRIV_CONST_OUT + THEN + FAILED( "WRONG OUTPUT VALUES - PROC1" ); + END IF; + + -------------------------------------------------------------- + + ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 ); + ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 ); + + PROC2( LIM_PRIV_VAR_1 , PACKAGED(17) , + LIM_PRIV_VAR_2 , PACKAGED(17) ); + + IF NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) )) OR + NOT(EQUALS( LIM_PRIV_VAR_2 , PACKAGED(13) )) + THEN + FAILED( "WRONG OUTPUT VALUES - PROC2" ); + END IF; + + -------------------------------------------------------------- + + PRIV_VAR_1 := PRIV_CONST_IN; + PRIV_VAR_2 := PRIV_CONST_IN; + + PRIV_VAR_1 := + FUNC1( PRIV_VAR_1 , U => PRIV_CONST_IN ); + + IF PRIV_VAR_1 /= PACK.PRIV_CONST_OUT + THEN + FAILED( "WRONG OUTPUT VALUES - FUNC1" ); + END IF; + + -------------------------------------------------------------- + + ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 ); + ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 ); + + ASSIGN( FUNC2( LIM_PRIV_VAR_1 , PACKAGED(17)) , + LIM_PRIV_VAR_1 ); + + IF NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) )) + THEN + FAILED( "WRONG OUTPUT VALUES - FUNC2" ); + END IF; + + -------------------------------------------------------------- + + END; + + + RESULT; + + +END C74209A; |