1-- CC3123A.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 DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY
26-- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS.
27
28-- TBN  12/01/86
29
30WITH REPORT; USE REPORT;
31PROCEDURE CC3123A IS
32
33BEGIN
34     TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " &
35                      "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " &
36                      "NO ACTUAL PARAMETERS");
37     DECLARE
38          TYPE ENUM IS (I, II, III);
39          OBJ_INT : INTEGER := 1;
40          OBJ_ENUM : ENUM := I;
41
42          GENERIC
43               GEN_INT : IN INTEGER := IDENT_INT(2);
44               GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE);
45               GEN_ENUM : IN ENUM := II;
46          PACKAGE P IS
47               PAC_INT : INTEGER := GEN_INT;
48               PAC_BOOL : BOOLEAN := GEN_BOOL;
49               PAC_ENUM : ENUM := GEN_ENUM;
50          END P;
51
52          PACKAGE P1 IS NEW P;
53          PACKAGE P2 IS
54               NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM);
55          PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE));
56     BEGIN
57          IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN
58               FAILED ("DEFAULT VALUES WERE NOT EVALUATED");
59          END IF;
60          IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN
61               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
62                       "- 1");
63          END IF;
64          IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR
65               P3.PAC_ENUM /= II THEN
66               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
67                       "- 2");
68          END IF;
69     END;
70
71     -------------------------------------------------------------------
72     DECLARE
73          OBJ_INT1 : INTEGER := 3;
74
75          FUNCTION FUNC (X : INTEGER) RETURN INTEGER;
76
77          GENERIC
78               GEN_INT1 : IN INTEGER := FUNC (1);
79               GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1);
80          PROCEDURE PROC;
81
82          PROCEDURE PROC IS
83               PROC_INT1 : INTEGER := GEN_INT1;
84               PROC_INT2 : INTEGER := GEN_INT2;
85          BEGIN
86               IF PROC_INT1 /= 3 THEN
87                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
88                            "CORRECTLY - 3");
89               END IF;
90               IF PROC_INT2 /= 4 THEN
91                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
92                            "CORRECTLY - 4");
93               END IF;
94          END PROC;
95
96          FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
97          BEGIN
98               IF X /= IDENT_INT(4) THEN
99                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
100                            "CORRECTLY - 5");
101               END IF;
102               RETURN IDENT_INT(X);
103          END FUNC;
104
105          PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1);
106
107     BEGIN
108          NEW_PROC;
109     END;
110
111     -------------------------------------------------------------------
112     DECLARE
113          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
114          TYPE REC IS
115               RECORD
116                    ANS : BOOLEAN;
117                    ARA : ARA_TYP;
118               END RECORD;
119          TYPE ARA_REC IS ARRAY (1 .. 5) OF REC;
120
121          FUNCTION F (X : INTEGER) RETURN INTEGER;
122
123          OBJ_REC : REC := (FALSE, (3, 4));
124          OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4)));
125
126          GENERIC
127               GEN_OBJ1 : IN ARA_TYP := (F(1), 2);
128               GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1);
129               GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2)));
130          FUNCTION FUNC RETURN INTEGER;
131
132          FUNCTION FUNC RETURN INTEGER IS
133          BEGIN
134               RETURN IDENT_INT(1);
135          END FUNC;
136
137          FUNCTION F (X : INTEGER) RETURN INTEGER IS
138          BEGIN
139               FAILED ("DEFAULT VALUES WERE EVALUATED - 1");
140               RETURN IDENT_INT(X);
141          END F;
142
143          FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA);
144
145     BEGIN
146          IF NOT EQUAL (NEW_FUNC, 1) THEN
147               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1");
148          END IF;
149     END;
150
151     -------------------------------------------------------------------
152     DECLARE
153          SUBTYPE INT IS INTEGER RANGE 1 .. 5;
154          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
155          TYPE COLOR IS (RED, WHITE);
156          TYPE CON_REC (D : INT) IS
157               RECORD
158                    A : COLOR;
159                    B : ARA_TYP;
160               END RECORD;
161          TYPE UNCON_OR_CON_REC (D : INT := 2) IS
162               RECORD
163                    A : COLOR;
164                    B : ARA_TYP;
165               END RECORD;
166          FUNCTION F (X : COLOR) RETURN COLOR;
167
168          OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4));
169          OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4));
170          OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4));
171
172          GENERIC
173               GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2));
174               GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2));
175               GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON;
176          FUNCTION FUNC RETURN INTEGER;
177
178          FUNCTION FUNC RETURN INTEGER IS
179          BEGIN
180               RETURN IDENT_INT(1);
181          END FUNC;
182
183          FUNCTION F (X : COLOR) RETURN COLOR IS
184          BEGIN
185               FAILED ("DEFAULT VALUES WERE EVALUATED - 2");
186               RETURN WHITE;
187          END F;
188
189          FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2);
190
191     BEGIN
192          IF NOT EQUAL (NEW_FUNC, 1) THEN
193               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2");
194          END IF;
195     END;
196
197     RESULT;
198END CC3123A;
199