1-- C95072B.ADA
2
3--                             Grant of Unlimited Rights
4--
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
14--     to do so.
15--
16--                                    DISCLAIMER
17--
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.
24--*
25-- CHECK THAT PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
26-- PASSED BY COPY FOR ALL MODES.
27-- SUBTESTS ARE:
28--   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
29--   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.
30
31-- JWC 7/22/85
32
33WITH REPORT; USE REPORT;
34PROCEDURE C95072B IS
35
36BEGIN
37     TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
38                     "PARAMETERS ARE COPIED");
39
40     ---------------------------------------------------
41
42     DECLARE  -- (A)
43
44          PACKAGE SCALAR_PKG IS
45
46               TYPE T IS PRIVATE;
47               C0 : CONSTANT T;
48               C1 : CONSTANT T;
49               C10 : CONSTANT T;
50               C100 : CONSTANT T;
51
52               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
53               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
54
55          PRIVATE
56
57               TYPE T IS NEW INTEGER;
58               C0 : CONSTANT T := 0;
59               C1 : CONSTANT T := 1;
60               C10 : CONSTANT T := 10;
61               C100 : CONSTANT T := 100;
62
63          END SCALAR_PKG;
64
65          PACKAGE BODY SCALAR_PKG IS
66
67               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
68               BEGIN
69                    RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
70               END "+";
71
72               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
73               BEGIN
74                    RETURN INTEGER (OLD_PRIVATE);
75               END CONVERT;
76
77          END SCALAR_PKG;
78
79          USE SCALAR_PKG;
80
81     BEGIN  -- (A)
82
83          DECLARE  -- (A1)
84
85               I : T;
86               E : EXCEPTION;
87
88               TASK TA IS
89                    ENTRY EA (EI : IN T; EO : OUT T;
90                              EIO : IN OUT T);
91               END TA;
92
93               TASK BODY TA IS
94
95                    TEMP : T;
96
97               BEGIN
98
99                    ACCEPT EA (EI : IN T; EO : OUT T;
100                               EIO : IN OUT T) DO
101
102                         TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.
103
104                         EO := C10;
105                         IF EI /= TEMP THEN
106                              FAILED ("ASSIGNMENT TO PRIVATE " &
107                                      "(SCALAR) OUT PARAMETER " &
108                                      "CHANGES THE VALUE OF INPUT " &
109                                      "PARAMETER");
110                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
111                         END IF;
112
113                         EIO := EIO + C100;
114                         IF EI /= TEMP THEN
115                              FAILED ("ASSIGNMENT TO PRIVATE " &
116                                      "(SCALAR) IN OUT PARAMETER " &
117                                      "CHANGES THE VALUE OF INPUT " &
118                                      "PARAMETER");
119                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
120                         END IF;
121
122                         I := I + C1;
123                         IF EI /= TEMP THEN
124                              FAILED ("ASSIGNMENT TO PRIVATE " &
125                                      "(SCALAR) ACTUAL PARAMETER " &
126                                      "CHANGES THE VALUE OF " &
127                                      "INPUT PARAMETER");
128                         END IF;
129
130                         RAISE E;              -- CHECK EXCEPTION
131                                               -- HANDLING.
132                    END EA;
133
134               EXCEPTION
135                    WHEN OTHERS => NULL;
136               END TA;
137
138          BEGIN    -- (A1)
139
140               I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
141                         -- DETECTED.
142               TA.EA (I, I, I);
143               FAILED ("EXCEPTION NOT RAISED - A");
144
145          EXCEPTION
146               WHEN E =>
147                    IF I /= C1 THEN
148                         CASE CONVERT (I) IS
149                              WHEN 11 =>
150                                   FAILED ("OUT ACTUAL PRIVATE " &
151                                           "(SCALAR) PARAMETER " &
152                                           "CHANGED GLOBAL VALUE");
153                              WHEN 101 =>
154                                   FAILED ("IN OUT ACTUAL PRIVATE " &
155                                           "(SCALAR) PARAMETER " &
156                                           "CHANGED GLOBAL VALUE");
157                              WHEN 111 =>
158                                   FAILED ("OUT AND IN OUT ACTUAL " &
159                                           "PRIVATE (SCALAR) " &
160                                           "PARAMETER CHANGED " &
161                                           "GLOBAL VALUE");
162                              WHEN OTHERS =>
163                                   FAILED ("UNDETERMINED CHANGE TO " &
164                                           "GLOBAL VALUE");
165                         END CASE;
166                    END IF;
167               WHEN OTHERS =>
168                    FAILED ("WRONG EXCEPTION RAISED - A");
169          END;  -- (A1)
170
171     END;  -- (A)
172
173     ---------------------------------------------------
174
175     DECLARE  -- (B)
176
177          PACKAGE ACCESS_PKG IS
178
179               TYPE T IS PRIVATE;
180               C_NULL : CONSTANT T;
181               C1 : CONSTANT T;
182               C10 : CONSTANT T;
183               C100 : CONSTANT T;
184               C101 : CONSTANT T;
185
186          PRIVATE
187
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);
194
195          END ACCESS_PKG;
196
197          USE ACCESS_PKG;
198
199     BEGIN    -- (B)
200
201          DECLARE  -- (B1)
202
203               I : T;
204               E : EXCEPTION;
205
206               TASK TB IS
207                    ENTRY EB (EI : IN T; EO : OUT T;
208                              EIO : IN OUT T);
209               END TB;
210
211               TASK BODY TB IS
212
213                    TEMP : T;
214
215               BEGIN
216
217                    ACCEPT EB (EI : IN T; EO : OUT T;
218                               EIO : IN OUT T) DO
219
220                         TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.
221
222                         I := C101;
223                         IF EI /= TEMP THEN
224                              FAILED ("ASSIGNMENT TO PRIVATE " &
225                                      "(ACCESS) ACTUAL VARIABLE " &
226                                      "CHANGES THE VALUE OF INPUT " &
227                                      "PARAMETER");
228                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
229                         END IF;
230
231                         EO := C1;
232                         IF EI /= TEMP THEN
233                              FAILED ("ASSIGNMENT TO PRIVATE " &
234                                      "(ACCESS) OUT PARAMETER " &
235                                      "CHANGES THE VALUE OF INPUT " &
236                                      "PARAMETER");
237                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
238                         END IF;
239
240                         EIO := C10;
241                         IF EI /= TEMP THEN
242                              FAILED ("ASSIGNMENT TO PRIVATE " &
243                                      "(ACCESS) IN OUT PARAMETER " &
244                                      "CHANGES THE VALUE OF INPUT " &
245                                      "PARAMETER");
246                         END IF;
247
248                         RAISE E;                 -- CHECK EXCEPTION
249                                                  -- HANDLING.
250                    END EB;
251
252               EXCEPTION
253                    WHEN OTHERS => NULL;
254               END TB;
255
256          BEGIN     -- (B1)
257
258               I := C100;
259               TB.EB (I, I, I);
260               FAILED ("EXCEPTION NOT RAISED - B");
261
262          EXCEPTION
263               WHEN E =>
264                    IF I /= C101 THEN
265                         FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
266                                 "PARAMETER VALUE CHANGED DESPITE " &
267                                 "RAISED EXCEPTION");
268                    END IF;
269               WHEN OTHERS =>
270                    FAILED ("WRONG EXCEPTION RAISED - B");
271          END;  -- (B1)
272
273     END;  -- (B)
274
275     ---------------------------------------------------
276
277     RESULT;
278END C95072B;
279