1-- CC3017C.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-- OBJECTIVE:
26--     CHECK THAT AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
27--     PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
28--     DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS
29--     ARE COPIED.
30--
31--     SUBTESTS ARE:
32--         (A) SCALAR PARAMETERS TO PROCEDURES.
33--         (B) SCALAR PARAMETERS TO FUNCTIONS.
34--         (C) ACCESS PARAMETERS TO PROCEDURES.
35--         (D) ACCESS PARAMETERS TO FUNCTIONS.
36
37-- HISTORY:
38--     EDWARD V. BERARD, 7 AUGUST 1990
39--     CJJ 10/16/90  ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED
40--                   HEADER TO CONFORM TO ACVC STANDARDS.
41--
42
43WITH REPORT;
44PROCEDURE CC3017C IS
45
46BEGIN
47     REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " &
48                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
49                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
50                  "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " &
51                  "ARE COPIED");
52
53     --------------------------------------------------
54
55     SCALAR_TO_PROCS:
56
57     DECLARE
58
59--        (A) SCALAR PARAMETERS TO PROCEDURES.
60
61          TYPE NUMBER IS RANGE 0 .. 120 ;
62          VALUE : NUMBER ;
63          E     : EXCEPTION ;
64
65          GENERIC
66
67            TYPE SCALAR_ITEM IS RANGE <> ;
68
69          PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
70                       P_OUT     : OUT SCALAR_ITEM ;
71                       P_IN_OUT : IN OUT SCALAR_ITEM) ;
72
73          PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
74                       P_OUT     : OUT SCALAR_ITEM ;
75                       P_IN_OUT : IN OUT SCALAR_ITEM) IS
76
77               STORE  : SCALAR_ITEM ;
78
79          BEGIN  -- P
80
81               STORE := P_IN;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
82
83               P_OUT := 10;
84               IF (P_IN /= STORE) THEN
85                    REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " &
86                                   "PARAMETER CHANGES THE VALUE OF " &
87                                   "INPUT PARAMETER");
88                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
89               END IF;
90
91               P_IN_OUT := P_IN_OUT + 100;
92               IF (P_IN /= STORE) THEN
93                    REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
94                                   "PARAMETER CHANGES THE VALUE OF " &
95                                   "INPUT PARAMETER");
96                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
97               END IF;
98
99               VALUE := VALUE + 1;
100               IF (P_IN /= STORE) THEN
101                    REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " &
102                                   "PARAMETER CHANGES THE VALUE OF " &
103                                   "INPUT PARAMETER");
104               END IF;
105
106               RAISE E;  -- CHECK EXCEPTION HANDLING.
107          END P;
108
109          PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ;
110
111     BEGIN  -- SCALAR_TO_PROCS
112          VALUE := 0;   -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED.
113
114          NEW_P (P_IN     => VALUE,
115                 P_OUT    => VALUE,
116                 P_IN_OUT => VALUE);
117
118          REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES");
119     EXCEPTION
120          WHEN E =>
121               IF (VALUE /= 1) THEN
122                    CASE VALUE IS
123                         WHEN 11  =>
124                              REPORT.FAILED ("OUT ACTUAL SCALAR " &
125                                             "PARAMETER CHANGED GLOBAL VALUE");
126                         WHEN 101 =>
127                              REPORT.FAILED ("IN OUT ACTUAL SCALAR " &
128                                             "PARAMETER CHANGED GLOBAL VALUE");
129                         WHEN 111 =>
130                              REPORT.FAILED ("OUT AND IN OUT ACTUAL " &
131                                             "SCALAR PARAMETERS CHANGED " &
132                                             "GLOBAL VALUE");
133                         WHEN OTHERS =>
134                              REPORT.FAILED ("UNDETERMINED CHANGE TO " &
135                                             "GLOBAL VALUE");
136                    END CASE;
137               END IF;
138          WHEN OTHERS =>
139              REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES");
140     END SCALAR_TO_PROCS ;
141
142     --------------------------------------------------
143
144     SCALAR_TO_FUNCS:
145
146     DECLARE
147
148--        (B) SCALAR PARAMETERS TO FUNCTIONS.
149
150          TYPE NUMBER IS RANGE 0 .. 101 ;
151          FIRST  : NUMBER ;
152          SECOND : NUMBER ;
153
154          GENERIC
155
156              TYPE ITEM IS RANGE <> ;
157
158          FUNCTION F (F_IN : IN ITEM) RETURN ITEM ;
159
160          FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS
161
162               STORE  : ITEM := F_IN;
163
164          BEGIN  -- F
165
166               FIRST := FIRST + 1;
167               IF (F_IN /= STORE) THEN
168                    REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " &
169                                   "PARAMETER CHANGES THE VALUE OF " &
170                                   "INPUT PARAMETER");
171               END IF;
172
173               RETURN (100);
174          END F;
175
176          FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ;
177
178     BEGIN  -- SCALAR_TO_FUNCS
179          FIRST  := 100 ;
180          SECOND := NEW_F (FIRST) ;
181     END SCALAR_TO_FUNCS ;
182
183     --------------------------------------------------
184
185     ACCESS_TO_PROCS:
186
187     DECLARE
188
189--        (C) ACCESS PARAMETERS TO PROCEDURES.
190
191          TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
192                               SEP, OCT, NOV, DEC) ;
193          TYPE DAY_TYPE IS RANGE 1 .. 31 ;
194          TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
195          TYPE DATE IS RECORD
196              MONTH : MONTH_TYPE ;
197              DAY   : DAY_TYPE ;
198              YEAR  : YEAR_TYPE ;
199          END RECORD ;
200
201          TYPE DATE_ACCESS IS ACCESS DATE ;
202          DATE_POINTER : DATE_ACCESS ;
203
204          E    : EXCEPTION;
205
206          GENERIC
207
208            TYPE ITEM IS PRIVATE ;
209            TYPE ACCESS_ITEM IS ACCESS ITEM ;
210
211          PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;
212                       P_OUT    : OUT    ACCESS_ITEM ;
213                       P_IN_OUT : IN OUT ACCESS_ITEM) ;
214
215          PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;
216                       P_OUT    : OUT    ACCESS_ITEM ;
217                       P_IN_OUT : IN OUT ACCESS_ITEM) IS
218
219               STORE  : ACCESS_ITEM ;
220
221          BEGIN  -- P
222
223               STORE := P_IN ;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
224
225               DATE_POINTER := NEW DATE'(YEAR  => 1990,
226                                         DAY   => 7,
227                                         MONTH => AUG) ;
228               IF (P_IN /= STORE) THEN
229                    REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " &
230                                   "PARAMETER CHANGES THE VALUE OF " &
231                                   "INPUT PARAMETER");
232                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
233               END IF;
234
235               P_OUT := NEW ITEM ;
236               IF (P_IN /= STORE) THEN
237                    REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " &
238                                   "PARAMETER CHANGES THE VALUE OF " &
239                                   "INPUT PARAMETER");
240                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
241               END IF;
242
243               P_IN_OUT :=  NEW ITEM ;
244               IF (P_IN /= STORE) THEN
245                    REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
246                                   "PARAMETER CHANGES THE VALUE OF " &
247                                   "INPUT PARAMETER");
248               END IF;
249
250               RAISE E;  -- CHECK EXCEPTION HANDLING.
251          END P ;
252
253          PROCEDURE NEW_P IS NEW P (ITEM         => DATE,
254                                    ACCESS_ITEM  => DATE_ACCESS) ;
255
256     BEGIN  -- ACCESS_TO_PROCS
257          DATE_POINTER := NEW DATE'(MONTH => DEC,
258                                    DAY   => 25,
259                                    YEAR  => 2000) ;
260
261          NEW_P (P_IN       => DATE_POINTER,
262                   P_OUT    => DATE_POINTER,
263                   P_IN_OUT => DATE_POINTER) ;
264
265          REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES");
266     EXCEPTION
267          WHEN E =>
268               IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN
269                    REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
270                                   "PARAMETER VALUE CHANGED DESPITE " &
271                                   "RAISED EXCEPTION");
272               END IF;
273          WHEN OTHERS =>
274               REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES");
275     END ACCESS_TO_PROCS ;
276
277     --------------------------------------------------
278
279     ACCESS_TO_FUNCS:
280
281     DECLARE
282
283--        (D) ACCESS PARAMETERS TO FUNCTIONS.
284
285          TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
286                               SEP, OCT, NOV, DEC) ;
287          TYPE DAY_TYPE IS RANGE 1 .. 31 ;
288          TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
289          TYPE DATE IS RECORD
290            MONTH : MONTH_TYPE ;
291            DAY   : DAY_TYPE ;
292            YEAR  : YEAR_TYPE ;
293          END RECORD ;
294
295          TYPE DATE_ACCESS IS ACCESS DATE ;
296          DATE_POINTER : DATE_ACCESS ;
297          NEXT_DATE    : DATE_ACCESS ;
298
299          GENERIC
300
301            TYPE ITEM IS PRIVATE ;
302            TYPE ACCESS_ITEM IS ACCESS ITEM ;
303
304          FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ;
305
306          FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS
307
308               STORE  : ACCESS_ITEM := F_IN ;
309
310          BEGIN  -- F
311
312               DATE_POINTER := NEW DATE'(YEAR  => 1990,
313                                            DAY   => 7,
314                                         MONTH => AUG) ;
315               IF (F_IN /= STORE) THEN
316                    REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " &
317                                   "PARAMETER CHANGES THE VALUE OF " &
318                                   "INPUT PARAMETER");
319               END IF;
320
321               RETURN (NULL);
322          END F ;
323
324          FUNCTION NEW_F IS NEW F (ITEM        => DATE,
325                                   ACCESS_ITEM => DATE_ACCESS) ;
326
327     BEGIN  -- ACCESS_TO_FUNCS
328          DATE_POINTER := NULL ;
329          NEXT_DATE    := NEW_F(F_IN => DATE_POINTER) ;
330     END ACCESS_TO_FUNCS ;
331
332     --------------------------------------------------
333
334     REPORT.RESULT;
335
336END CC3017C;
337