1-- CC1308A.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 FORMAL SUBPROGRAM PARAMETERS MAY OVERLOAD EACH OTHER
27--     AND OTHER VISIBLE SUBPROGRAMS AND ENUMERATION LITERALS WITHIN AND
28--     OUTSIDE OF THE GENERIC UNIT.
29
30-- HISTORY:
31--     DAT 09/08/81  CREATED ORIGINAL TEST.
32--     SPS 10/26/82
33--     SPS 02/09/83
34--     BCB 08/09/88  REPLACED THE OLD TEST WITH A VERSION BASED ON
35--                   AIG 6.6/T2.
36
37WITH REPORT; USE REPORT;
38
39PROCEDURE CC1308A IS
40
41     TYPE ENUM IS (F1,F2,F3,F4,F5,F6,F7);
42
43     FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
44     BEGIN
45          RETURN 2*X;
46     END F1;
47
48     PROCEDURE F1 (X : IN OUT INTEGER) IS
49     BEGIN
50          X := 3*X;
51     END F1;
52
53     PROCEDURE F2 (Y : IN OUT INTEGER; Z : IN OUT BOOLEAN) IS
54     BEGIN
55          Y := 2*Y;
56          Z := NOT Z;
57     END F2;
58
59     PROCEDURE F2 (Y : IN OUT INTEGER) IS
60     BEGIN
61          Y := 3*Y;
62     END F2;
63
64     PROCEDURE F3 (B : BOOLEAN := FALSE; A : IN OUT INTEGER) IS
65     BEGIN
66          A := 2*A;
67     END F3;
68
69     PROCEDURE F3 (A : IN OUT INTEGER) IS
70     BEGIN
71          A := 3*A;
72     END F3;
73
74     PROCEDURE F4 (C : IN OUT INTEGER) IS
75     BEGIN
76          C := 2*C;
77     END F4;
78
79     PROCEDURE F4 (C : IN OUT BOOLEAN) IS
80     BEGIN
81          C := NOT C;
82     END F4;
83
84     PROCEDURE F5 (D : IN OUT INTEGER; E : IN OUT BOOLEAN) IS
85     BEGIN
86          D := 2*D;
87          E := NOT E;
88     END F5;
89
90     PROCEDURE F5 (E : IN OUT BOOLEAN; D : IN OUT INTEGER) IS
91     BEGIN
92          E := NOT E;
93          D := 3*D;
94     END F5;
95
96     FUNCTION F6 (G : INTEGER) RETURN INTEGER IS
97     BEGIN
98          RETURN 2*G;
99     END F6;
100
101     FUNCTION F6 (G : INTEGER) RETURN BOOLEAN IS
102     BEGIN
103          RETURN TRUE;
104     END F6;
105
106     FUNCTION F7 RETURN INTEGER IS
107     BEGIN
108          RETURN 25;
109     END F7;
110
111     FUNCTION F7 RETURN BOOLEAN IS
112     BEGIN
113          RETURN FALSE;
114     END F7;
115
116BEGIN
117     TEST ("CC1308A", "CHECK THAT FORMAL SUBPROGRAM PARAMETERS MAY " &
118                      "OVERLOAD EACH OTHER AND OTHER VISIBLE " &
119                      "SUBPROGRAMS AND ENUMERATION LITERALS WITHIN " &
120                      "AND OUTSIDE OF THE GENERIC UNIT");
121
122     DECLARE
123          GENERIC
124               WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER;
125               WITH PROCEDURE F1 (X : IN OUT INTEGER);
126
127               WITH PROCEDURE F2 (Y : IN OUT INTEGER;
128                                  Z : IN OUT BOOLEAN);
129               WITH PROCEDURE F2 (Y : IN OUT INTEGER);
130
131               WITH PROCEDURE F3 (B : BOOLEAN := FALSE;
132                                  A : IN OUT INTEGER);
133               WITH PROCEDURE F3 (A : IN OUT INTEGER);
134
135               WITH PROCEDURE F4 (C : IN OUT INTEGER);
136               WITH PROCEDURE F4 (C : IN OUT BOOLEAN);
137
138               WITH PROCEDURE F5 (D : IN OUT INTEGER;
139                                  E : IN OUT BOOLEAN);
140               WITH PROCEDURE F5 (E : IN OUT BOOLEAN;
141                                  D : IN OUT INTEGER);
142
143               WITH FUNCTION F6 (G : INTEGER) RETURN INTEGER;
144               WITH FUNCTION F6 (G : INTEGER) RETURN BOOLEAN;
145
146               WITH FUNCTION F7 RETURN INTEGER;
147               WITH FUNCTION F7 RETURN BOOLEAN;
148          PACKAGE P IS
149               TYPE EN IS (F1,F2,F3,F4,F5,F6,F7);
150          END P;
151
152          PACKAGE BODY P IS
153               X1, X2, Y1, Y2, A1, A2, C1, D1, D2, G1
154                  : INTEGER := IDENT_INT(5);
155
156               VAL : INTEGER := IDENT_INT(0);
157
158               Z1, B1, C2, E1, E2, BOOL : BOOLEAN := IDENT_BOOL(FALSE);
159          BEGIN
160               VAL := F1(X1);
161
162               IF NOT EQUAL(VAL,10) THEN
163                    FAILED ("CASE 1 - WRONG VALUE RETURNED FROM " &
164                            "FUNCTION");
165               END IF;
166
167               F1(X2);
168
169               IF NOT EQUAL(X2,15) THEN
170                    FAILED ("CASE 1 - WRONG VALUE ASSIGNED INSIDE " &
171                            "PROCEDURE");
172               END IF;
173
174               F2(Y1,Z1);
175
176               IF NOT EQUAL(Y1,10) OR Z1 /= TRUE THEN
177                    FAILED ("CASE 2 - WRONG VALUES ASSIGNED INSIDE " &
178                            "PROCEDURE");
179               END IF;
180
181               F2(Y2);
182
183               IF NOT EQUAL(Y2,15) THEN
184                    FAILED ("CASE 2 - WRONG VALUE ASSIGNED INSIDE " &
185                            "PROCEDURE");
186               END IF;
187
188               F3(B1,A1);
189
190               IF NOT EQUAL(A1,10) OR B1 /= FALSE THEN
191                    FAILED ("CASE 3 - WRONG VALUES ASSIGNED INSIDE " &
192                            "PROCEDURE");
193               END IF;
194
195               F3(A2);
196
197               IF NOT EQUAL(A2,15) THEN
198                    FAILED ("CASE 3 - WRONG VALUE ASSIGNED INSIDE " &
199                            "PROCEDURE");
200               END IF;
201
202               F4(C1);
203
204               IF NOT EQUAL(C1,10) THEN
205                    FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
206                            "PROCEDURE - BASE TYPE INTEGER");
207               END IF;
208
209               F4(C2);
210
211               IF C2 /= TRUE THEN
212                    FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
213                            "PROCEDURE - BASE TYPE BOOLEAN");
214               END IF;
215
216               F5(D1,E1);
217
218               IF NOT EQUAL(D1,10) OR E1 /= TRUE THEN
219                    FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
220                            "PROCEDURE - ORDER WAS INTEGER, BOOLEAN");
221               END IF;
222
223               F5(E2,D2);
224
225               IF E2 /= TRUE OR NOT EQUAL(D2,15) THEN
226                    FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
227                            "PROCEDURE - ORDER WAS BOOLEAN, INTEGER");
228               END IF;
229
230               VAL := F6(G1);
231
232               IF NOT EQUAL(VAL,10) THEN
233                    FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
234                            "FUNCTION - TYPE INTEGER");
235               END IF;
236
237               BOOL := F6(G1);
238
239               IF BOOL /= TRUE THEN
240                    FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
241                            "FUNCTION - TYPE BOOLEAN");
242               END IF;
243
244               VAL := F7;
245
246               IF NOT EQUAL(VAL,25) THEN
247                    FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
248                            "PARAMETERLESS FUNCTION - TYPE INTEGER");
249               END IF;
250
251               BOOL := F7;
252
253               IF BOOL /= FALSE THEN
254                    FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
255                            "PARAMETERLESS FUNCTION - TYPE BOOLEAN");
256               END IF;
257          END P;
258
259          PACKAGE NEW_P IS NEW P (F1, F1, F2, F2, F3, F3,
260                                  F4, F4, F5, F5, F6, F6, F7, F7);
261     BEGIN
262          NULL;
263     END;
264
265     RESULT;
266END CC1308A;
267