3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
25 -- CHECK THAT OUTSIDE A PACKAGE WHICH DEFINES PRIVATE TYPES AND LIMITED
26 -- PRIVATE TYPES IT IS POSSIBLE TO DECLARE SUBPROGRAMS WHICH USE
27 -- THOSE TYPES AS TYPES FOR PARAMETERS (OF ANY MODE EXCEPT OUT FOR A
28 -- LIMITED TYPE) OR AS THE TYPE FOR THE RESULT (FOR FUNCTION
41 TEST
( "C74209A" , "CHECK THAT PROCEDURE SIGNATURES CAN USE " &
48 TYPE LIM_PRIV
IS LIMITED PRIVATE;
50 PRIV_CONST_IN
: CONSTANT PRIV
;
51 PRIV_CONST_OUT
: CONSTANT PRIV
;
52 FUNCTION PACKAGED
( X
: IN INTEGER ) RETURN LIM_PRIV
;
53 FUNCTION EQUALS
( X
, Y
: LIM_PRIV
) RETURN BOOLEAN ;
54 PROCEDURE ASSIGN
( X
: IN LIM_PRIV
; Y
: OUT LIM_PRIV
);
58 TYPE LIM_PRIV
IS NEW INTEGER;
59 TYPE PRIV
IS NEW STRING( 1..5 );
60 PRIV_CONST_IN
: CONSTANT PRIV
:= "ABCDE";
61 PRIV_CONST_OUT
: CONSTANT PRIV
:= "FGHIJ";
66 PRIV_VAR_1
, PRIV_VAR_2
: PACK
.PRIV
;
67 LIM_PRIV_VAR_1
, LIM_PRIV_VAR_2
: PACK
.LIM_PRIV
;
75 FUNCTION PACKAGED
( X
: IN INTEGER ) RETURN LIM_PRIV
IS
80 FUNCTION EQUALS
( X
, Y
: LIM_PRIV
) RETURN BOOLEAN IS
85 PROCEDURE ASSIGN
( X
: IN LIM_PRIV
; Y
: OUT LIM_PRIV
) IS
93 PROCEDURE PROC1
( X
: IN OUT PACK
.PRIV
;
94 Y
: IN PACK
.PRIV
:= PACK
.PRIV_CONST_IN
;
99 IF X
/= PACK
.PRIV_CONST_IN
OR
100 Y
/= PACK
.PRIV_CONST_IN
OR
101 U
/= PACK
.PRIV_CONST_IN
103 FAILED
( "WRONG INPUT VALUES - PROC1" );
106 X
:= PACK
.PRIV_CONST_OUT
;
107 Z
:= PACK
.PRIV_CONST_OUT
;
112 PROCEDURE PROC2
( X
: IN OUT LIM_PRIV
;
118 IF NOT(EQUALS
( X
, PACKAGED
(17) )) OR
119 NOT(EQUALS
( Y
, PACKAGED
(17) )) OR
120 NOT(EQUALS
( U
, PACKAGED
(17) ))
122 FAILED
( "WRONG INPUT VALUES - PROC2" );
125 ASSIGN
( PACKAGED
(13) , X
);
126 ASSIGN
( PACKAGED
(13) , Z
);
131 FUNCTION FUNC1
( Y
: IN PRIV
:= PRIV_CONST_IN
;
132 U
: PRIV
) RETURN PRIV
IS
135 IF Y
/= PRIV_CONST_IN
OR
138 FAILED
( "WRONG INPUT VALUES - FUNC1" );
141 RETURN PRIV_CONST_OUT
;
146 FUNCTION FUNC2
( Y
: IN LIM_PRIV
;
147 U
: LIM_PRIV
) RETURN LIM_PRIV
IS
150 IF NOT(EQUALS
( Y
, PACKAGED
(17) )) OR
151 NOT(EQUALS
( U
, PACKAGED
(17) ))
153 FAILED
( "WRONG INPUT VALUES - FUNC2" );
163 --------------------------------------------------------------
165 PRIV_VAR_1
:= PRIV_CONST_IN
;
166 PRIV_VAR_2
:= PRIV_CONST_IN
;
168 PROC1
( PRIV_VAR_1
, Z
=> PRIV_VAR_2
, U
=> PRIV_CONST_IN
);
170 IF PRIV_VAR_1
/= PACK
.PRIV_CONST_OUT
OR
171 PRIV_VAR_2
/= PACK
.PRIV_CONST_OUT
173 FAILED
( "WRONG OUTPUT VALUES - PROC1" );
176 --------------------------------------------------------------
178 ASSIGN
( PACKAGED
(17) , LIM_PRIV_VAR_1
);
179 ASSIGN
( PACKAGED
(17) , LIM_PRIV_VAR_2
);
181 PROC2
( LIM_PRIV_VAR_1
, PACKAGED
(17) ,
182 LIM_PRIV_VAR_2
, PACKAGED
(17) );
184 IF NOT(EQUALS
( LIM_PRIV_VAR_1
, PACKAGED
(13) )) OR
185 NOT(EQUALS
( LIM_PRIV_VAR_2
, PACKAGED
(13) ))
187 FAILED
( "WRONG OUTPUT VALUES - PROC2" );
190 --------------------------------------------------------------
192 PRIV_VAR_1
:= PRIV_CONST_IN
;
193 PRIV_VAR_2
:= PRIV_CONST_IN
;
196 FUNC1
( PRIV_VAR_1
, U
=> PRIV_CONST_IN
);
198 IF PRIV_VAR_1
/= PACK
.PRIV_CONST_OUT
200 FAILED
( "WRONG OUTPUT VALUES - FUNC1" );
203 --------------------------------------------------------------
205 ASSIGN
( PACKAGED
(17) , LIM_PRIV_VAR_1
);
206 ASSIGN
( PACKAGED
(17) , LIM_PRIV_VAR_2
);
208 ASSIGN
( FUNC2
( LIM_PRIV_VAR_1
, PACKAGED
(17)) ,
211 IF NOT(EQUALS
( LIM_PRIV_VAR_1
, PACKAGED
(13) ))
213 FAILED
( "WRONG OUTPUT VALUES - FUNC2" );
216 --------------------------------------------------------------