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