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/] [c3/] [c37213h.ada] - Blame information for rev 316

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


-- C37213H.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, WHERE AN INDEX CONSTRAINT DEPENDS ON A RECORD
--     DISCRIMINANT WITH A DEFAULT VALUE AND THE RECORD TYPE IS NOT
--     EXPLICITLY CONSTRAINED, THAT THE NON-DISCRIMINANT EXPRESSIONS
--     IN THE INDEX CONSTRAINT ARE:
--          1) EVALUATED WHEN THE RECORD COMPONENT SUBTYPE DEFINITION
--             IS ELABORATED,
--          2) PROPERLY CHECKED FOR COMPATIBILITY ONLY IN AN ALLOCATION
--             OR OBJECT DECLARATION AND ONLY IF THE DISCRIMINANT-
--             DEPENDENT COMPONENT IS PRESENT IN THE SUBTYPE.
 
-- HISTORY:
--     JBG  10/17/86  CREATED ORIGINAL TEST.
--     VCL  10/23/87  MODIFIED THIS HEADER; MODIFIED THE CHECK OF
--                    SUBTYPE 'SCONS', IN BOTH SUBPARTS OF THE TEST,
--                    TO INDICATE FAILURE IF CONSTRAINT_ERROR IS RAISED
--                    FOR THE SUBTYPE DECLARATION AND FAILURE IF
--                    CONSTRAINT_ERROR IS NOT RAISED FOR AN OBJECT
--                    DECLARATION OF THIS SUBTYPE; RELOCATED THE CALL TO
--                    REPORT.TEST SO THAT IT COMES BEFORE ANY
--                    DECLARATIONS;  ADDED 'SEQUENCE_NUMBER' TO IDENTIFY
--                    THE CURRENT SUBTEST (FOR EXCEPTIONS); CHANGE THE
--                    TYPE OF THE DISCRIMINANT IN THE RECORD 'CONS'
--                    TO AN INTEGER SUBTYPE.
--     VCL  03/30/88  MODIFIED HEADER AND MESSAGES OUTPUT BY REPORT
--                    PACKAGE.
 
WITH REPORT; USE REPORT;
PROCEDURE C37213H IS
BEGIN
     TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &
                      "INDEX CONSTRAINT THAT DEPEND ON A " &
                      "DISCRIMINANT WITH A DEFAULT VALUE ARE " &
                      "PROPERLY EVALUATED AND CHECKED WHEN THE " &
                      "RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &
                      "THE COMPONENT IS AND IS NOT PRESENT IN THE " &
                      "SUBTYPE");
 
     DECLARE
          SEQUENCE_NUMBER : INTEGER;
 
          SUBTYPE DISCR IS INTEGER RANGE -50..50;
          SUBTYPE SM IS INTEGER RANGE 1..10;
          TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
 
          F1_CONS : INTEGER := 2;
 
          FUNCTION CHK (
               CONS    : INTEGER;
               VALUE   : INTEGER;
               MESSAGE : STRING) RETURN BOOLEAN IS
          BEGIN
               IF CONS /= VALUE THEN
                    FAILED (MESSAGE & ": F1_CONS IS " &
                            INTEGER'IMAGE(F1_CONS));
               END IF;
               RETURN TRUE;
          END CHK;
 
          FUNCTION F1 RETURN INTEGER IS
          BEGIN
               F1_CONS := F1_CONS - IDENT_INT(1);
               RETURN F1_CONS;
          END F1;
     BEGIN
 
 
-- CASE 1: DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT.
 
          SEQUENCE_NUMBER :=1;
          DECLARE
               TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
                    RECORD
                         CASE D3 IS
                              WHEN -5..10 =>
                                   C1 : MY_ARR(F1..D3); -- F1 EVALUATED.
                              WHEN OTHERS =>
                                   C2 : INTEGER := IDENT_INT(0);
                         END CASE;
                    END RECORD;
 
               CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
 
               X : CONS;                     -- F1 NOT EVALUATED AGAIN.
               Y : CONS;                     -- F1 NOT EVALUATED AGAIN.
 
               CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
          BEGIN
               IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
                    FAILED ("VALUES NOT CORRECT");
               END IF;
          END;
 
 
          F1_CONS := 12;
 
          SEQUENCE_NUMBER := 2;
          DECLARE
               TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
                    RECORD
                         CASE D3 IS
                              WHEN -5..10 =>
                                   C1 : MY_ARR(D3..F1);
                              WHEN OTHERS =>
                                   C2 : INTEGER := IDENT_INT(0);
                         END CASE;
                    END RECORD;
          BEGIN
               BEGIN
                    DECLARE
                         X : CONS;
                    BEGIN
                         FAILED ("INDEX CHECK NOT PERFORMED - 1");
                         IF X /= (1, (1, 1)) THEN
                              COMMENT ("INCORRECT VALUES FOR X - 1");
                         END IF;
                    END;
               EXCEPTION
                    WHEN CONSTRAINT_ERROR =>
                         NULL;
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
               END;
 
               BEGIN
                    DECLARE
                         SUBTYPE SCONS IS CONS;
                    BEGIN
                         DECLARE
                              X : SCONS;
                         BEGIN
                              FAILED ("INDEX CHECK NOT PERFORMED - 2");
                              IF X /= (1, (1, 1)) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 2");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
                                      "- 2A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE ARR IS ARRAY (1..5) OF CONS;
                    BEGIN
                         DECLARE
                              X : ARR;
                         BEGIN
                              FAILED ("INDEX CHECK NOT PERFORMED - 3");
                              IF X /= (1..5 => (1, (1, 1))) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 3");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
                                      "- 3A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE NREC IS
                              RECORD
                                   C1 : CONS;
                              END RECORD;
                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              FAILED ("INDEX CHECK NOT PERFORMED - 4");
                              IF X /= (C1 => (1, (1, 1))) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 4");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
                                      "- 4A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE NREC IS NEW CONS;
                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              FAILED ("INDEX CHECK NOT PERFORMED - 5");
                              IF X /= (1, (1, 1)) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 5");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
                                       "- 5A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE ACC_CONS IS ACCESS CONS;
                    BEGIN
                         DECLARE
                              X : ACC_CONS;
                         BEGIN
                              X := NEW CONS;
                              FAILED ("INDEX CHECK NOT PERFORMED - 6");
                              IF X.ALL /= (1, (1, 1)) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 6");
                              END IF;
                         EXCEPTION
                              WHEN CONSTRAINT_ERROR =>
                                   NULL;
                              WHEN OTHERS =>
                                   COMMENT ("UNEXPECTED EXCEPTION " &
                                            "RAISED - 6A");
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              COMMENT ("UNEXPECTED EXCEPTION RAISED " &
                                       "- 6B");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
               END;
          END;
 
 
-- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.
 
          F1_CONS := 2;
 
          SEQUENCE_NUMBER := 3;
          DECLARE
               TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
                    RECORD
                         CASE D3 IS
                              WHEN -5..10 =>
                                   C1 : MY_ARR(D3..F1); -- F1 EVALUATED.
                              WHEN OTHERS =>
                                   C2 : INTEGER := IDENT_INT(0);
                         END CASE;
                    END RECORD;
               CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
 
               X : CONS;                      -- F1 NOT EVALUATED AGAIN.
               Y : CONS;                      -- F1 NOT EVALUATED AGAIN.
 
               CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
          BEGIN
               IF X /= (-6, 0) OR Y /= (-6, 0) THEN
                    FAILED ("VALUES NOT CORRECT");
               END IF;
          END;
 
          F1_CONS := 12;
 
          SEQUENCE_NUMBER := 4;
          DECLARE
               TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
                    RECORD
                         CASE D3 IS
                              WHEN -5..10 =>
                                   C1 : MY_ARR(D3..F1);
                              WHEN OTHERS =>
                                   C2 : INTEGER := IDENT_INT(0);
                         END CASE;
                    END RECORD;
          BEGIN
               BEGIN
                    DECLARE
                         X : CONS;
                    BEGIN
                         IF X /= (11, 0) THEN
                              FAILED ("X VALUE IS INCORRECT - 11");
                         END IF;
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
               END;
 
               BEGIN
                    DECLARE
                         SUBTYPE SCONS IS CONS;
                    BEGIN
                         DECLARE
                              X : SCONS;
                         BEGIN
                              IF X /= (11, 0) THEN
                                   FAILED ("X VALUE INCORRECT - 12");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "12A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE ARR IS ARRAY (1..5) OF CONS;
                    BEGIN
                         DECLARE
                              X : ARR;
                         BEGIN
                              IF X /= (1..5 => (11, 0)) THEN
                                   FAILED ("X VALUE INCORRECT - 13");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "13A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE NREC IS
                              RECORD
                                   C1 : CONS;
                              END RECORD;
                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              IF X /= (C1 => (11, 0)) THEN
                                   FAILED ("X VALUE INCORRECT - 14");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "14A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE NREC IS NEW CONS;
                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              IF X /= (11, 0) THEN
                                   FAILED ("X VALUE INCORRECT - 15");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "15A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
               END;
 
               BEGIN
                    DECLARE
                         TYPE ACC_CONS IS ACCESS CONS;
                         X : ACC_CONS;
                    BEGIN
                         X := NEW CONS;
                         IF X.ALL /= (11, 0) THEN
                              FAILED ("X VALUE INCORRECT - 17");
                         END IF;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "17A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                          FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
               END;
          END;
 
     EXCEPTION
          WHEN CONSTRAINT_ERROR =>
               FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
                       INTEGER'IMAGE (SEQUENCE_NUMBER));
          WHEN OTHERS =>
               FAILED ("UNEXPECTED EXCEPTION RAISED " &
                       INTEGER'IMAGE (SEQUENCE_NUMBER));
     END;
 
     RESULT;
END C37213H;

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c37213h.ada] - Blame information for rev 316

Line No.	Rev	Author	Line
1	294	jeremybenn	`-- C37213H.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, WHERE AN INDEX CONSTRAINT DEPENDS ON A RECORD`
27			`-- DISCRIMINANT WITH A DEFAULT VALUE AND THE RECORD TYPE IS NOT`
28			`-- EXPLICITLY CONSTRAINED, THAT THE NON-DISCRIMINANT EXPRESSIONS`
29			`-- IN THE INDEX CONSTRAINT ARE:`
30			`-- 1) EVALUATED WHEN THE RECORD COMPONENT SUBTYPE DEFINITION`
31			`-- IS ELABORATED,`
32			`-- 2) PROPERLY CHECKED FOR COMPATIBILITY ONLY IN AN ALLOCATION`
33			`-- OR OBJECT DECLARATION AND ONLY IF THE DISCRIMINANT-`
34			`-- DEPENDENT COMPONENT IS PRESENT IN THE SUBTYPE.`
35
36			`-- HISTORY:`
37			`-- JBG 10/17/86 CREATED ORIGINAL TEST.`
38			`-- VCL 10/23/87 MODIFIED THIS HEADER; MODIFIED THE CHECK OF`
39			`-- SUBTYPE 'SCONS', IN BOTH SUBPARTS OF THE TEST,`
40			`-- TO INDICATE FAILURE IF CONSTRAINT_ERROR IS RAISED`
41			`-- FOR THE SUBTYPE DECLARATION AND FAILURE IF`
42			`-- CONSTRAINT_ERROR IS NOT RAISED FOR AN OBJECT`
43			`-- DECLARATION OF THIS SUBTYPE; RELOCATED THE CALL TO`
44			`-- REPORT.TEST SO THAT IT COMES BEFORE ANY`
45			`-- DECLARATIONS; ADDED 'SEQUENCE_NUMBER' TO IDENTIFY`
46			`-- THE CURRENT SUBTEST (FOR EXCEPTIONS); CHANGE THE`
47			`-- TYPE OF THE DISCRIMINANT IN THE RECORD 'CONS'`
48			`-- TO AN INTEGER SUBTYPE.`
49			`-- VCL 03/30/88 MODIFIED HEADER AND MESSAGES OUTPUT BY REPORT`
50			`-- PACKAGE.`
51
52			`WITH REPORT; USE REPORT;`
53			`PROCEDURE C37213H IS`
54			`BEGIN`
55			`TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &`
56			`"INDEX CONSTRAINT THAT DEPEND ON A " &`
57			`"DISCRIMINANT WITH A DEFAULT VALUE ARE " &`
58			`"PROPERLY EVALUATED AND CHECKED WHEN THE " &`
59			`"RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &`
60			`"THE COMPONENT IS AND IS NOT PRESENT IN THE " &`
61			`"SUBTYPE");`
62
63			`DECLARE`
64			`SEQUENCE_NUMBER : INTEGER;`
65
66			`SUBTYPE DISCR IS INTEGER RANGE -50..50;`
67			`SUBTYPE SM IS INTEGER RANGE 1..10;`
68			`TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;`
69
70			`F1_CONS : INTEGER := 2;`
71
72			`FUNCTION CHK (`
73			`CONS : INTEGER;`
74			`VALUE : INTEGER;`
75			`MESSAGE : STRING) RETURN BOOLEAN IS`
76			`BEGIN`
77			`IF CONS /= VALUE THEN`
78			`FAILED (MESSAGE & ": F1_CONS IS " &`
79			`INTEGER'IMAGE(F1_CONS));`
80			`END IF;`
81			`RETURN TRUE;`
82			`END CHK;`
83
84			`FUNCTION F1 RETURN INTEGER IS`
85			`BEGIN`
86			`F1_CONS := F1_CONS - IDENT_INT(1);`
87			`RETURN F1_CONS;`
88			`END F1;`
89			`BEGIN`
90
91
92			`-- CASE 1: DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT.`
93
94			`SEQUENCE_NUMBER :=1;`
95			`DECLARE`
96			`TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS`
97			`RECORD`
98			`CASE D3 IS`
99			`WHEN -5..10 =>`
100			`C1 : MY_ARR(F1..D3); -- F1 EVALUATED.`
101			`WHEN OTHERS =>`
102			`C2 : INTEGER := IDENT_INT(0);`
103			`END CASE;`
104			`END RECORD;`
105
106			`CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");`
107
108			`X : CONS; -- F1 NOT EVALUATED AGAIN.`
109			`Y : CONS; -- F1 NOT EVALUATED AGAIN.`
110
111			`CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");`
112			`BEGIN`
113			`IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN`
114			`FAILED ("VALUES NOT CORRECT");`
115			`END IF;`
116			`END;`
117
118
119			`F1_CONS := 12;`
120
121			`SEQUENCE_NUMBER := 2;`
122			`DECLARE`
123			`TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS`
124			`RECORD`
125			`CASE D3 IS`
126			`WHEN -5..10 =>`
127			`C1 : MY_ARR(D3..F1);`
128			`WHEN OTHERS =>`
129			`C2 : INTEGER := IDENT_INT(0);`
130			`END CASE;`
131			`END RECORD;`
132			`BEGIN`
133			`BEGIN`
134			`DECLARE`
135			`X : CONS;`
136			`BEGIN`
137			`FAILED ("INDEX CHECK NOT PERFORMED - 1");`
138			`IF X /= (1, (1, 1)) THEN`
139			`COMMENT ("INCORRECT VALUES FOR X - 1");`
140			`END IF;`
141			`END;`
142			`EXCEPTION`
143			`WHEN CONSTRAINT_ERROR =>`
144			`NULL;`
145			`WHEN OTHERS =>`
146			`FAILED ("UNEXPECTED EXCEPTION RAISED - 1");`
147			`END;`
148
149			`BEGIN`
150			`DECLARE`
151			`SUBTYPE SCONS IS CONS;`
152			`BEGIN`
153			`DECLARE`
154			`X : SCONS;`
155			`BEGIN`
156			`FAILED ("INDEX CHECK NOT PERFORMED - 2");`
157			`IF X /= (1, (1, 1)) THEN`
158			`COMMENT ("INCORRECT VALUES FOR X " &`
159			`"- 2");`
160			`END IF;`
161			`END;`
162			`EXCEPTION`
163			`WHEN CONSTRAINT_ERROR =>`
164			`NULL;`
165			`WHEN OTHERS =>`
166			`FAILED ("UNEXPECTED EXCEPTION RAISED " &`
167			`"- 2A");`
168			`END;`
169			`EXCEPTION`
170			`WHEN OTHERS =>`
171			`FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");`
172			`END;`
173
174			`BEGIN`
175			`DECLARE`
176			`TYPE ARR IS ARRAY (1..5) OF CONS;`
177			`BEGIN`
178			`DECLARE`
179			`X : ARR;`
180			`BEGIN`
181			`FAILED ("INDEX CHECK NOT PERFORMED - 3");`
182			`IF X /= (1..5 => (1, (1, 1))) THEN`
183			`COMMENT ("INCORRECT VALUES FOR X " &`
184			`"- 3");`
185			`END IF;`
186			`END;`
187			`EXCEPTION`
188			`WHEN CONSTRAINT_ERROR =>`
189			`NULL;`
190			`WHEN OTHERS =>`
191			`FAILED ("UNEXPECTED EXCEPTION RAISED " &`
192			`"- 3A");`
193			`END;`
194			`EXCEPTION`
195			`WHEN OTHERS =>`
196			`FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");`
197			`END;`
198
199			`BEGIN`
200			`DECLARE`
201			`TYPE NREC IS`
202			`RECORD`
203			`C1 : CONS;`
204			`END RECORD;`
205			`BEGIN`
206			`DECLARE`
207			`X : NREC;`
208			`BEGIN`
209			`FAILED ("INDEX CHECK NOT PERFORMED - 4");`
210			`IF X /= (C1 => (1, (1, 1))) THEN`
211			`COMMENT ("INCORRECT VALUES FOR X " &`
212			`"- 4");`
213			`END IF;`
214			`END;`
215			`EXCEPTION`
216			`WHEN CONSTRAINT_ERROR =>`
217			`NULL;`
218			`WHEN OTHERS =>`
219			`FAILED ("UNEXPECTED EXCEPTION RAISED " &`
220			`"- 4A");`
221			`END;`
222			`EXCEPTION`
223			`WHEN OTHERS =>`
224			`FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");`
225			`END;`
226
227			`BEGIN`
228			`DECLARE`
229			`TYPE NREC IS NEW CONS;`
230			`BEGIN`
231			`DECLARE`
232			`X : NREC;`
233			`BEGIN`
234			`FAILED ("INDEX CHECK NOT PERFORMED - 5");`
235			`IF X /= (1, (1, 1)) THEN`
236			`COMMENT ("INCORRECT VALUES FOR X " &`
237			`"- 5");`
238			`END IF;`
239			`END;`
240			`EXCEPTION`
241			`WHEN CONSTRAINT_ERROR =>`
242			`NULL;`
243			`WHEN OTHERS =>`
244			`FAILED ("UNEXPECTED EXCEPTION RAISED " &`
245			`"- 5A");`
246			`END;`
247			`EXCEPTION`
248			`WHEN OTHERS =>`
249			`FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");`
250			`END;`
251
252			`BEGIN`
253			`DECLARE`
254			`TYPE ACC_CONS IS ACCESS CONS;`
255			`BEGIN`
256			`DECLARE`
257			`X : ACC_CONS;`
258			`BEGIN`
259			`X := NEW CONS;`
260			`FAILED ("INDEX CHECK NOT PERFORMED - 6");`
261			`IF X.ALL /= (1, (1, 1)) THEN`
262			`COMMENT ("INCORRECT VALUES FOR X " &`
263			`"- 6");`
264			`END IF;`
265			`EXCEPTION`
266			`WHEN CONSTRAINT_ERROR =>`
267			`NULL;`
268			`WHEN OTHERS =>`
269			`COMMENT ("UNEXPECTED EXCEPTION " &`
270			`"RAISED - 6A");`
271			`END;`
272			`EXCEPTION`
273			`WHEN OTHERS =>`
274			`COMMENT ("UNEXPECTED EXCEPTION RAISED " &`
275			`"- 6B");`
276			`END;`
277			`EXCEPTION`
278			`WHEN OTHERS =>`
279			`FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");`
280			`END;`
281			`END;`
282
283
284			`-- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.`
285
286			`F1_CONS := 2;`
287
288			`SEQUENCE_NUMBER := 3;`
289			`DECLARE`
290			`TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS`
291			`RECORD`
292			`CASE D3 IS`
293			`WHEN -5..10 =>`
294			`C1 : MY_ARR(D3..F1); -- F1 EVALUATED.`
295			`WHEN OTHERS =>`
296			`C2 : INTEGER := IDENT_INT(0);`
297			`END CASE;`
298			`END RECORD;`
299			`CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");`
300
301			`X : CONS; -- F1 NOT EVALUATED AGAIN.`
302			`Y : CONS; -- F1 NOT EVALUATED AGAIN.`
303
304			`CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");`
305			`BEGIN`
306			`IF X /= (-6, 0) OR Y /= (-6, 0) THEN`
307			`FAILED ("VALUES NOT CORRECT");`
308			`END IF;`
309			`END;`
310
311			`F1_CONS := 12;`
312
313			`SEQUENCE_NUMBER := 4;`
314			`DECLARE`
315			`TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS`
316			`RECORD`
317			`CASE D3 IS`
318			`WHEN -5..10 =>`
319			`C1 : MY_ARR(D3..F1);`
320			`WHEN OTHERS =>`
321			`C2 : INTEGER := IDENT_INT(0);`
322			`END CASE;`
323			`END RECORD;`
324			`BEGIN`
325			`BEGIN`
326			`DECLARE`
327			`X : CONS;`
328			`BEGIN`
329			`IF X /= (11, 0) THEN`
330			`FAILED ("X VALUE IS INCORRECT - 11");`
331			`END IF;`
332			`END;`
333			`EXCEPTION`
334			`WHEN OTHERS =>`
335			`FAILED ("UNEXPECTED EXCEPTION RAISED - 11");`
336			`END;`
337
338			`BEGIN`
339			`DECLARE`
340			`SUBTYPE SCONS IS CONS;`
341			`BEGIN`
342			`DECLARE`
343			`X : SCONS;`
344			`BEGIN`
345			`IF X /= (11, 0) THEN`
346			`FAILED ("X VALUE INCORRECT - 12");`
347			`END IF;`
348			`END;`
349			`EXCEPTION`
350			`WHEN OTHERS =>`
351			`FAILED ("UNEXPECTED EXCEPTION RAISED - " &`
352			`"12A");`
353			`END;`
354			`EXCEPTION`
355			`WHEN OTHERS =>`
356			`FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");`
357			`END;`
358
359			`BEGIN`
360			`DECLARE`
361			`TYPE ARR IS ARRAY (1..5) OF CONS;`
362			`BEGIN`
363			`DECLARE`
364			`X : ARR;`
365			`BEGIN`
366			`IF X /= (1..5 => (11, 0)) THEN`
367			`FAILED ("X VALUE INCORRECT - 13");`
368			`END IF;`
369			`END;`
370			`EXCEPTION`
371			`WHEN OTHERS =>`
372			`FAILED ("UNEXPECTED EXCEPTION RAISED - " &`
373			`"13A");`
374			`END;`
375			`EXCEPTION`
376			`WHEN OTHERS =>`
377			`FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");`
378			`END;`
379
380			`BEGIN`
381			`DECLARE`
382			`TYPE NREC IS`
383			`RECORD`
384			`C1 : CONS;`
385			`END RECORD;`
386			`BEGIN`
387			`DECLARE`
388			`X : NREC;`
389			`BEGIN`
390			`IF X /= (C1 => (11, 0)) THEN`
391			`FAILED ("X VALUE INCORRECT - 14");`
392			`END IF;`
393			`END;`
394			`EXCEPTION`
395			`WHEN OTHERS =>`
396			`FAILED ("UNEXPECTED EXCEPTION RAISED - " &`
397			`"14A");`
398			`END;`
399			`EXCEPTION`
400			`WHEN OTHERS =>`
401			`FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");`
402			`END;`
403
404			`BEGIN`
405			`DECLARE`
406			`TYPE NREC IS NEW CONS;`
407			`BEGIN`
408			`DECLARE`
409			`X : NREC;`
410			`BEGIN`
411			`IF X /= (11, 0) THEN`
412			`FAILED ("X VALUE INCORRECT - 15");`
413			`END IF;`
414			`END;`
415			`EXCEPTION`
416			`WHEN CONSTRAINT_ERROR =>`
417			`NULL;`
418			`WHEN OTHERS =>`
419			`FAILED ("UNEXPECTED EXCEPTION RAISED - " &`
420			`"15A");`
421			`END;`
422			`EXCEPTION`
423			`WHEN OTHERS =>`
424			`FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");`
425			`END;`
426
427			`BEGIN`
428			`DECLARE`
429			`TYPE ACC_CONS IS ACCESS CONS;`
430			`X : ACC_CONS;`
431			`BEGIN`
432			`X := NEW CONS;`
433			`IF X.ALL /= (11, 0) THEN`
434			`FAILED ("X VALUE INCORRECT - 17");`
435			`END IF;`
436			`EXCEPTION`
437			`WHEN OTHERS =>`
438			`FAILED ("UNEXPECTED EXCEPTION RAISED - " &`
439			`"17A");`
440			`END;`
441			`EXCEPTION`
442			`WHEN OTHERS =>`
443			`FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");`
444			`END;`
445			`END;`
446
447			`EXCEPTION`
448			`WHEN CONSTRAINT_ERROR =>`
449			`FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &`
450			`INTEGER'IMAGE (SEQUENCE_NUMBER));`
451			`WHEN OTHERS =>`
452			`FAILED ("UNEXPECTED EXCEPTION RAISED " &`
453			`INTEGER'IMAGE (SEQUENCE_NUMBER));`
454			`END;`
455
456			`RESULT;`
457			`END C37213H;`