URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3128a.ada] - Blame information for rev 309

Go to most recent revision | Details | Compare with Previous | View Log


-- CC3128A.ADA
 
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- OBJECTIVE:
--     CHECK THAT, FOR A CONSTRAINED IN FORMAL PARAMETER HAVING AN ACCESS TYPE,
--     CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL PARAMETER IS NOT
--     NULL AND THE OBJECT DESIGNATED BY THE ACTUAL PARAMETER DOES NOT SATISFY
--     THE FORMAL PARAMETER'S CONSTRAINTS.
 
-- HISTORY:
--     RJW 10/28/88  CREATED ORIGINAL TEST.
--     JRL 02/28/96  Removed cases where the designated subtypes of the formal
--                   and actual do not statically match. Corrected commentary.
 
WITH REPORT; USE REPORT;
PROCEDURE CC3128A IS
 
BEGIN
     TEST ("CC3128A", "FOR A CONSTRAINED IN FORMAL PARAMETER HAVING " &
                      "AN ACCESS TYPE, CONSTRAINT_ERROR IS RAISED " &
                      "IF AND ONLY IF THE ACTUAL PARAMETER IS NOT " &
                      "NULL AND THE OBJECT DESIGNATED BY THE ACTUAL " &
                      "PARAMETER DOES NOT SATISFY FORMAL PARAMETER'S " &
                      "CONSTRAINTS");
 
     DECLARE
          TYPE REC (D : INTEGER := 10) IS
               RECORD
                    NULL;
               END RECORD;
 
          TYPE ACCREC IS ACCESS REC;
 
          SUBTYPE LINK IS ACCREC (5);
 
          GENERIC
               LINK1 : LINK;
          FUNCTION F (I : INTEGER) RETURN INTEGER;
 
          FUNCTION F (I : INTEGER) RETURN INTEGER IS
          BEGIN
               IF I /= 5 THEN
                    FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
                            "TO CALL TO FUNCTION F - 1");
               END IF;
               IF NOT EQUAL (I, 5) AND THEN
                  NOT EQUAL (LINK1.D, LINK1.D) THEN
                    COMMENT ("DISREGARD");
               END IF;
               RETURN I + 1;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 1");
               RETURN I + 1;
          END F;
 
          GENERIC
               TYPE PRIV (D : INTEGER) IS PRIVATE;
               PRIV1 : PRIV;
          PACKAGE GEN IS
               TYPE ACCPRIV IS ACCESS PRIV;
               SUBTYPE LINK IS ACCPRIV (5);
               GENERIC
                    LINK1 : LINK;
                    I : IN OUT INTEGER;
               PACKAGE P IS END P;
          END GEN;
 
          PACKAGE BODY GEN IS
               PACKAGE BODY P IS
               BEGIN
                    IF I /= 5 THEN
                         FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
                                 "TO PACKAGE BODY P - 1");
                    END IF;
                    IF NOT EQUAL (I, 5) AND THEN
                       NOT EQUAL (LINK1.D, LINK1.D) THEN
                         COMMENT ("DISREGARD");
                    END IF;
                    I := I + 1;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED WITHIN " &
                                 "PACKAGE P - 1");
                    I := I + 1;
               END P;
 
          BEGIN
               BEGIN
                    DECLARE
                         AR10 : ACCPRIV;
                         I : INTEGER := IDENT_INT (5);
                         PACKAGE P1 IS NEW P (AR10, I);
                    BEGIN
                         IF I /= 6 THEN
                              FAILED ("INCORRECT RESULT - " &
                                      "PACKAGE P1");
                         END IF;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("EXCEPTION RAISED TOO LATE - " &
                                      "PACKAGE P1 - 1");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
                                 "OF PACKAGE P1 WITH NULL ACCESS " &
                                 "VALUE");
               END;
 
               BEGIN
                    DECLARE
                         AR10 : ACCPRIV := NEW PRIV'(PRIV1);
                         I : INTEGER := IDENT_INT (0);
                         PACKAGE P1 IS NEW P (AR10, I);
                    BEGIN
                         FAILED ("NO EXCEPTION RAISED BY " &
                                 "INSTANTIATION OF PACKAGE P1");
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("EXCEPTION RAISED TOO LATE - " &
                                      "PACKAGE P1 - 2");
                    END;
               EXCEPTION
                    WHEN CONSTRAINT_ERROR =>
                         NULL;
                    WHEN OTHERS =>
                         FAILED ("WRONG EXCEPTION RAISED AT " &
                                 "INSTANTIATION OF PACKAGE P1");
               END;
          END GEN;
 
          PACKAGE NEWGEN IS NEW GEN (REC, (D => 10));
 
     BEGIN
          BEGIN
               DECLARE
                    I : INTEGER := IDENT_INT (5);
                    AR10 : ACCREC;
                    FUNCTION F1 IS NEW F (AR10);
               BEGIN
                    I := F1 (I);
                    IF I /= 6 THEN
                         FAILED ("INCORRECT RESULT RETURNED BY " &
                                 "FUNCTION F1");
                    END IF;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED AT CALL TO " &
                                 "FUNCTION F1 - 1");
               END;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
                            "FUNCTION F1 WITH NULL ACCESS VALUE");
          END;
 
          BEGIN
               DECLARE
                    I : INTEGER := IDENT_INT (0);
                    AR10 : ACCREC := NEW REC'(D => 10);
                    FUNCTION F1 IS NEW F (AR10);
               BEGIN
                    FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
                            "OF FUNCTION F1");
                    I := F1 (I);
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED AT CALL TO " &
                                 "FUNCTION F1 - 2");
               END;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED AT " &
                            "INSTANTIATION OF FUNCTION F1");
          END;
     END;
 
     DECLARE
          TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
 
          TYPE ACCARR IS ACCESS ARR;
 
          SUBTYPE LINK IS ACCARR (1 .. 5);
 
          GENERIC
               LINK1 : LINK;
          FUNCTION F (I : INTEGER) RETURN INTEGER;
 
          FUNCTION F (I : INTEGER) RETURN INTEGER IS
          BEGIN
               IF I /= 5 THEN
                    FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
                            "TO CALL TO FUNCTION F - 2");
               END IF;
               IF NOT EQUAL (I, 5) AND THEN
                  NOT EQUAL (LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
                  THEN
                    COMMENT ("DISREGARD");
               END IF;
               RETURN I + 1;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 2");
               RETURN I + 1;
          END F;
 
          GENERIC
               TYPE GENARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
          PACKAGE GEN IS
               TYPE ACCGENARR IS ACCESS GENARR;
               SUBTYPE LINK IS ACCGENARR (1 .. 5);
               GENERIC
                    LINK1 : LINK;
                    I : IN OUT INTEGER;
               PACKAGE P IS END P;
          END GEN;
 
          PACKAGE BODY GEN IS
               PACKAGE BODY P IS
               BEGIN
                    IF I /= 5 THEN
                         FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
                                 "TO PACKAGE BODY P - 2");
                    END IF;
                    IF NOT EQUAL (I, 5) AND THEN
                       NOT
                       EQUAL(LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
                       THEN
                         COMMENT ("DISREGARD");
                    END IF;
                    I := I + 1;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED WITHIN " &
                                 "PACKAGE P - 2");
                    I := I + 1;
               END P;
 
          BEGIN
               BEGIN
                    DECLARE
                         AR26 : ACCGENARR (2 .. 6);
                         I : INTEGER := IDENT_INT (5);
                         PACKAGE P2 IS NEW P (AR26, I);
                    BEGIN
                         IF I /= 6 THEN
                              FAILED ("INCORRECT RESULT - " &
                                      "PACKAGE P2");
                         END IF;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("EXCEPTION RAISED TOO LATE - " &
                                      "PACKAGE P2 - 1");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
                                 "OF PACKAGE P2 WITH NULL ACCESS " &
                                 "VALUE");
               END;
 
               BEGIN
                    DECLARE
                         AR26 : ACCGENARR
                                (IDENT_INT (2) .. IDENT_INT (6)) :=
                                NEW GENARR'(1,2,3,4,5);
                         I : INTEGER := IDENT_INT (0);
                         PACKAGE P2 IS NEW P (AR26, I);
                    BEGIN
                         FAILED ("NO EXCEPTION RAISED BY " &
                                 "INSTANTIATION OF PACKAGE P2");
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("EXCEPTION RAISED TOO LATE - " &
                                      "PACKAGE P2 - 2");
                    END;
               EXCEPTION
                    WHEN CONSTRAINT_ERROR =>
                         NULL;
                    WHEN OTHERS =>
                         FAILED ("WRONG EXCEPTION RAISED AT " &
                                 "INSTANTIATION OF PACKAGE P2");
               END;
          END GEN;
 
          PACKAGE NEWGEN IS NEW GEN (ARR);
 
     BEGIN
          BEGIN
               DECLARE
                    I : INTEGER := IDENT_INT (5);
                    AR26 : ACCARR (IDENT_INT (2) .. IDENT_INT (6));
                    FUNCTION F2 IS NEW F (AR26);
               BEGIN
                    I := F2 (I);
                    IF I /= 6 THEN
                         FAILED ("INCORRECT RESULT RETURNED BY " &
                                 "FUNCTION F2");
                    END IF;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED AT CALL TO " &
                                 "FUNCTION F2 - 1");
               END;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
                            "FUNCTION F2 WITH NULL ACCESS VALUE");
          END;
 
          BEGIN
               DECLARE
                    I : INTEGER := IDENT_INT (0);
                    AR26 : ACCARR (2 .. 6) := NEW ARR'(1,2,3,4,5);
                    FUNCTION F2 IS NEW F (AR26);
               BEGIN
                    FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
                            "OF FUNCTION F2");
                    I := F2 (I);
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("EXCEPTION RAISED AT CALL TO " &
                                 "FUNCTION F2 - 2");
               END;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED AT " &
                            "INSTANTIATION OF FUNCTION F2");
          END;
     END;
     RESULT;
END CC3128A;

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3128a.ada] - Blame information for rev 309

Line No.	Rev	Author	Line
1	294	jeremybenn	`-- CC3128A.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, FOR A CONSTRAINED IN FORMAL PARAMETER HAVING AN ACCESS TYPE,`
27			`-- CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL PARAMETER IS NOT`
28			`-- NULL AND THE OBJECT DESIGNATED BY THE ACTUAL PARAMETER DOES NOT SATISFY`
29			`-- THE FORMAL PARAMETER'S CONSTRAINTS.`
30
31			`-- HISTORY:`
32			`-- RJW 10/28/88 CREATED ORIGINAL TEST.`
33			`-- JRL 02/28/96 Removed cases where the designated subtypes of the formal`
34			`-- and actual do not statically match. Corrected commentary.`
35
36			`WITH REPORT; USE REPORT;`
37			`PROCEDURE CC3128A IS`
38
39			`BEGIN`
40			`TEST ("CC3128A", "FOR A CONSTRAINED IN FORMAL PARAMETER HAVING " &`
41			`"AN ACCESS TYPE, CONSTRAINT_ERROR IS RAISED " &`
42			`"IF AND ONLY IF THE ACTUAL PARAMETER IS NOT " &`
43			`"NULL AND THE OBJECT DESIGNATED BY THE ACTUAL " &`
44			`"PARAMETER DOES NOT SATISFY FORMAL PARAMETER'S " &`
45			`"CONSTRAINTS");`
46
47			`DECLARE`
48			`TYPE REC (D : INTEGER := 10) IS`
49			`RECORD`
50			`NULL;`
51			`END RECORD;`
52
53			`TYPE ACCREC IS ACCESS REC;`
54
55			`SUBTYPE LINK IS ACCREC (5);`
56
57			`GENERIC`
58			`LINK1 : LINK;`
59			`FUNCTION F (I : INTEGER) RETURN INTEGER;`
60
61			`FUNCTION F (I : INTEGER) RETURN INTEGER IS`
62			`BEGIN`
63			`IF I /= 5 THEN`
64			`FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &`
65			`"TO CALL TO FUNCTION F - 1");`
66			`END IF;`
67			`IF NOT EQUAL (I, 5) AND THEN`
68			`NOT EQUAL (LINK1.D, LINK1.D) THEN`
69			`COMMENT ("DISREGARD");`
70			`END IF;`
71			`RETURN I + 1;`
72			`EXCEPTION`
73			`WHEN OTHERS =>`
74			`FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 1");`
75			`RETURN I + 1;`
76			`END F;`
77
78			`GENERIC`
79			`TYPE PRIV (D : INTEGER) IS PRIVATE;`
80			`PRIV1 : PRIV;`
81			`PACKAGE GEN IS`
82			`TYPE ACCPRIV IS ACCESS PRIV;`
83			`SUBTYPE LINK IS ACCPRIV (5);`
84			`GENERIC`
85			`LINK1 : LINK;`
86			`I : IN OUT INTEGER;`
87			`PACKAGE P IS END P;`
88			`END GEN;`
89
90			`PACKAGE BODY GEN IS`
91			`PACKAGE BODY P IS`
92			`BEGIN`
93			`IF I /= 5 THEN`
94			`FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &`
95			`"TO PACKAGE BODY P - 1");`
96			`END IF;`
97			`IF NOT EQUAL (I, 5) AND THEN`
98			`NOT EQUAL (LINK1.D, LINK1.D) THEN`
99			`COMMENT ("DISREGARD");`
100			`END IF;`
101			`I := I + 1;`
102			`EXCEPTION`
103			`WHEN OTHERS =>`
104			`FAILED ("EXCEPTION RAISED WITHIN " &`
105			`"PACKAGE P - 1");`
106			`I := I + 1;`
107			`END P;`
108
109			`BEGIN`
110			`BEGIN`
111			`DECLARE`
112			`AR10 : ACCPRIV;`
113			`I : INTEGER := IDENT_INT (5);`
114			`PACKAGE P1 IS NEW P (AR10, I);`
115			`BEGIN`
116			`IF I /= 6 THEN`
117			`FAILED ("INCORRECT RESULT - " &`
118			`"PACKAGE P1");`
119			`END IF;`
120			`EXCEPTION`
121			`WHEN OTHERS =>`
122			`FAILED ("EXCEPTION RAISED TOO LATE - " &`
123			`"PACKAGE P1 - 1");`
124			`END;`
125			`EXCEPTION`
126			`WHEN OTHERS =>`
127			`FAILED ("EXCEPTION RAISED AT INSTANTIATION " &`
128			`"OF PACKAGE P1 WITH NULL ACCESS " &`
129			`"VALUE");`
130			`END;`
131
132			`BEGIN`
133			`DECLARE`
134			`AR10 : ACCPRIV := NEW PRIV'(PRIV1);`
135			`I : INTEGER := IDENT_INT (0);`
136			`PACKAGE P1 IS NEW P (AR10, I);`
137			`BEGIN`
138			`FAILED ("NO EXCEPTION RAISED BY " &`
139			`"INSTANTIATION OF PACKAGE P1");`
140			`EXCEPTION`
141			`WHEN OTHERS =>`
142			`FAILED ("EXCEPTION RAISED TOO LATE - " &`
143			`"PACKAGE P1 - 2");`
144			`END;`
145			`EXCEPTION`
146			`WHEN CONSTRAINT_ERROR =>`
147			`NULL;`
148			`WHEN OTHERS =>`
149			`FAILED ("WRONG EXCEPTION RAISED AT " &`
150			`"INSTANTIATION OF PACKAGE P1");`
151			`END;`
152			`END GEN;`
153
154			`PACKAGE NEWGEN IS NEW GEN (REC, (D => 10));`
155
156			`BEGIN`
157			`BEGIN`
158			`DECLARE`
159			`I : INTEGER := IDENT_INT (5);`
160			`AR10 : ACCREC;`
161			`FUNCTION F1 IS NEW F (AR10);`
162			`BEGIN`
163			`I := F1 (I);`
164			`IF I /= 6 THEN`
165			`FAILED ("INCORRECT RESULT RETURNED BY " &`
166			`"FUNCTION F1");`
167			`END IF;`
168			`EXCEPTION`
169			`WHEN OTHERS =>`
170			`FAILED ("EXCEPTION RAISED AT CALL TO " &`
171			`"FUNCTION F1 - 1");`
172			`END;`
173			`EXCEPTION`
174			`WHEN OTHERS =>`
175			`FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &`
176			`"FUNCTION F1 WITH NULL ACCESS VALUE");`
177			`END;`
178
179			`BEGIN`
180			`DECLARE`
181			`I : INTEGER := IDENT_INT (0);`
182			`AR10 : ACCREC := NEW REC'(D => 10);`
183			`FUNCTION F1 IS NEW F (AR10);`
184			`BEGIN`
185			`FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &`
186			`"OF FUNCTION F1");`
187			`I := F1 (I);`
188			`EXCEPTION`
189			`WHEN OTHERS =>`
190			`FAILED ("EXCEPTION RAISED AT CALL TO " &`
191			`"FUNCTION F1 - 2");`
192			`END;`
193			`EXCEPTION`
194			`WHEN CONSTRAINT_ERROR =>`
195			`NULL;`
196			`WHEN OTHERS =>`
197			`FAILED ("WRONG EXCEPTION RAISED AT " &`
198			`"INSTANTIATION OF FUNCTION F1");`
199			`END;`
200			`END;`
201
202			`DECLARE`
203			`TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;`
204
205			`TYPE ACCARR IS ACCESS ARR;`
206
207			`SUBTYPE LINK IS ACCARR (1 .. 5);`
208
209			`GENERIC`
210			`LINK1 : LINK;`
211			`FUNCTION F (I : INTEGER) RETURN INTEGER;`
212
213			`FUNCTION F (I : INTEGER) RETURN INTEGER IS`
214			`BEGIN`
215			`IF I /= 5 THEN`
216			`FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &`
217			`"TO CALL TO FUNCTION F - 2");`
218			`END IF;`
219			`IF NOT EQUAL (I, 5) AND THEN`
220			`NOT EQUAL (LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))`
221			`THEN`
222			`COMMENT ("DISREGARD");`
223			`END IF;`
224			`RETURN I + 1;`
225			`EXCEPTION`
226			`WHEN OTHERS =>`
227			`FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 2");`
228			`RETURN I + 1;`
229			`END F;`
230
231			`GENERIC`
232			`TYPE GENARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;`
233			`PACKAGE GEN IS`
234			`TYPE ACCGENARR IS ACCESS GENARR;`
235			`SUBTYPE LINK IS ACCGENARR (1 .. 5);`
236			`GENERIC`
237			`LINK1 : LINK;`
238			`I : IN OUT INTEGER;`
239			`PACKAGE P IS END P;`
240			`END GEN;`
241
242			`PACKAGE BODY GEN IS`
243			`PACKAGE BODY P IS`
244			`BEGIN`
245			`IF I /= 5 THEN`
246			`FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &`
247			`"TO PACKAGE BODY P - 2");`
248			`END IF;`
249			`IF NOT EQUAL (I, 5) AND THEN`
250			`NOT`
251			`EQUAL(LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))`
252			`THEN`
253			`COMMENT ("DISREGARD");`
254			`END IF;`
255			`I := I + 1;`
256			`EXCEPTION`
257			`WHEN OTHERS =>`
258			`FAILED ("EXCEPTION RAISED WITHIN " &`
259			`"PACKAGE P - 2");`
260			`I := I + 1;`
261			`END P;`
262
263			`BEGIN`
264			`BEGIN`
265			`DECLARE`
266			`AR26 : ACCGENARR (2 .. 6);`
267			`I : INTEGER := IDENT_INT (5);`
268			`PACKAGE P2 IS NEW P (AR26, I);`
269			`BEGIN`
270			`IF I /= 6 THEN`
271			`FAILED ("INCORRECT RESULT - " &`
272			`"PACKAGE P2");`
273			`END IF;`
274			`EXCEPTION`
275			`WHEN OTHERS =>`
276			`FAILED ("EXCEPTION RAISED TOO LATE - " &`
277			`"PACKAGE P2 - 1");`
278			`END;`
279			`EXCEPTION`
280			`WHEN OTHERS =>`
281			`FAILED ("EXCEPTION RAISED AT INSTANTIATION " &`
282			`"OF PACKAGE P2 WITH NULL ACCESS " &`
283			`"VALUE");`
284			`END;`
285
286			`BEGIN`
287			`DECLARE`
288			`AR26 : ACCGENARR`
289			`(IDENT_INT (2) .. IDENT_INT (6)) :=`
290			`NEW GENARR'(1,2,3,4,5);`
291			`I : INTEGER := IDENT_INT (0);`
292			`PACKAGE P2 IS NEW P (AR26, I);`
293			`BEGIN`
294			`FAILED ("NO EXCEPTION RAISED BY " &`
295			`"INSTANTIATION OF PACKAGE P2");`
296			`EXCEPTION`
297			`WHEN OTHERS =>`
298			`FAILED ("EXCEPTION RAISED TOO LATE - " &`
299			`"PACKAGE P2 - 2");`
300			`END;`
301			`EXCEPTION`
302			`WHEN CONSTRAINT_ERROR =>`
303			`NULL;`
304			`WHEN OTHERS =>`
305			`FAILED ("WRONG EXCEPTION RAISED AT " &`
306			`"INSTANTIATION OF PACKAGE P2");`
307			`END;`
308			`END GEN;`
309
310			`PACKAGE NEWGEN IS NEW GEN (ARR);`
311
312			`BEGIN`
313			`BEGIN`
314			`DECLARE`
315			`I : INTEGER := IDENT_INT (5);`
316			`AR26 : ACCARR (IDENT_INT (2) .. IDENT_INT (6));`
317			`FUNCTION F2 IS NEW F (AR26);`
318			`BEGIN`
319			`I := F2 (I);`
320			`IF I /= 6 THEN`
321			`FAILED ("INCORRECT RESULT RETURNED BY " &`
322			`"FUNCTION F2");`
323			`END IF;`
324			`EXCEPTION`
325			`WHEN OTHERS =>`
326			`FAILED ("EXCEPTION RAISED AT CALL TO " &`
327			`"FUNCTION F2 - 1");`
328			`END;`
329			`EXCEPTION`
330			`WHEN OTHERS =>`
331			`FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &`
332			`"FUNCTION F2 WITH NULL ACCESS VALUE");`
333			`END;`
334
335			`BEGIN`
336			`DECLARE`
337			`I : INTEGER := IDENT_INT (0);`
338			`AR26 : ACCARR (2 .. 6) := NEW ARR'(1,2,3,4,5);`
339			`FUNCTION F2 IS NEW F (AR26);`
340			`BEGIN`
341			`FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &`
342			`"OF FUNCTION F2");`
343			`I := F2 (I);`
344			`EXCEPTION`
345			`WHEN OTHERS =>`
346			`FAILED ("EXCEPTION RAISED AT CALL TO " &`
347			`"FUNCTION F2 - 2");`
348			`END;`
349			`EXCEPTION`
350			`WHEN CONSTRAINT_ERROR =>`
351			`NULL;`
352			`WHEN OTHERS =>`
353			`FAILED ("WRONG EXCEPTION RAISED AT " &`
354			`"INSTANTIATION OF FUNCTION F2");`
355			`END;`
356			`END;`
357			`RESULT;`
358			`END CC3128A;`