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/] [c7/] [c74209a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- 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;