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 PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
26 -- PASSED BY COPY FOR ALL MODES.
28 -- (A) PRIVATE SCALAR PARAMETERS TO ENTRIES.
29 -- (B) PRIVATE ACCESS PARAMETERS TO ENTRIES.
33 WITH REPORT
; USE REPORT
;
37 TEST
("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
38 "PARAMETERS ARE COPIED");
40 ---------------------------------------------------
52 FUNCTION "+" (OLD
: IN T
; INCREMENT
: IN T
) RETURN T
;
53 FUNCTION CONVERT
(OLD_PRIVATE
: IN T
) RETURN INTEGER;
57 TYPE T
IS NEW INTEGER;
60 C10
: CONSTANT T
:= 10;
61 C100
: CONSTANT T
:= 100;
65 PACKAGE BODY SCALAR_PKG
IS
67 FUNCTION "+" (OLD
: IN T
; INCREMENT
: IN T
) RETURN T
IS
69 RETURN T
(INTEGER(OLD
) + INTEGER(INCREMENT
));
72 FUNCTION CONVERT
(OLD_PRIVATE
: IN T
) RETURN INTEGER IS
74 RETURN INTEGER (OLD_PRIVATE
);
89 ENTRY EA
(EI
: IN T
; EO
: OUT T
;
99 ACCEPT EA
(EI
: IN T
; EO
: OUT T
;
102 TEMP
:= EI
; -- SAVE VALUE OF EI AT ACCEPT.
106 FAILED
("ASSIGNMENT TO PRIVATE " &
107 "(SCALAR) OUT PARAMETER " &
108 "CHANGES THE VALUE OF INPUT " &
110 TEMP
:= EI
; -- RESET TEMP FOR NEXT CASE.
115 FAILED
("ASSIGNMENT TO PRIVATE " &
116 "(SCALAR) IN OUT PARAMETER " &
117 "CHANGES THE VALUE OF INPUT " &
119 TEMP
:= EI
; -- RESET TEMP FOR NEXT CASE.
124 FAILED
("ASSIGNMENT TO PRIVATE " &
125 "(SCALAR) ACTUAL PARAMETER " &
126 "CHANGES THE VALUE OF " &
130 RAISE E
; -- CHECK EXCEPTION
140 I
:= C0
; -- INITIALIZE I SO VARIOUS CASES CAN BE
143 FAILED
("EXCEPTION NOT RAISED - A");
150 FAILED
("OUT ACTUAL PRIVATE " &
151 "(SCALAR) PARAMETER " &
152 "CHANGED GLOBAL VALUE");
154 FAILED
("IN OUT ACTUAL PRIVATE " &
155 "(SCALAR) PARAMETER " &
156 "CHANGED GLOBAL VALUE");
158 FAILED
("OUT AND IN OUT ACTUAL " &
159 "PRIVATE (SCALAR) " &
160 "PARAMETER CHANGED " &
163 FAILED
("UNDETERMINED CHANGE TO " &
168 FAILED
("WRONG EXCEPTION RAISED - A");
173 ---------------------------------------------------
177 PACKAGE ACCESS_PKG
IS
188 TYPE T
IS ACCESS INTEGER;
189 C_NULL
: CONSTANT T
:= NULL;
190 C1
: CONSTANT T
:= NEW INTEGER'(1);
191 C10 : CONSTANT T := NEW INTEGER'(10);
192 C100
: CONSTANT T
:= NEW INTEGER'(100);
193 C101 : CONSTANT T := NEW INTEGER'(101);
207 ENTRY EB
(EI
: IN T
; EO
: OUT T
;
217 ACCEPT EB
(EI
: IN T
; EO
: OUT T
;
220 TEMP
:= EI
; -- SAVE VALUE OF EI AT ACCEPT.
224 FAILED
("ASSIGNMENT TO PRIVATE " &
225 "(ACCESS) ACTUAL VARIABLE " &
226 "CHANGES THE VALUE OF INPUT " &
228 TEMP
:= EI
; -- RESET TEMP FOR NEXT CASE.
233 FAILED
("ASSIGNMENT TO PRIVATE " &
234 "(ACCESS) OUT PARAMETER " &
235 "CHANGES THE VALUE OF INPUT " &
237 TEMP
:= EI
; -- RESET TEMP FOR NEXT CASE.
242 FAILED
("ASSIGNMENT TO PRIVATE " &
243 "(ACCESS) IN OUT PARAMETER " &
244 "CHANGES THE VALUE OF INPUT " &
248 RAISE E
; -- CHECK EXCEPTION
260 FAILED
("EXCEPTION NOT RAISED - B");
265 FAILED
("OUT OR IN OUT ACTUAL ENTRY " &
266 "PARAMETER VALUE CHANGED DESPITE " &
270 FAILED
("WRONG EXCEPTION RAISED - B");
275 ---------------------------------------------------