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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c35102a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log


-- C35102A.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.
--*
-- CHECK THAT AN ENUMERATION LITERAL BELONGING TO ONE ENUMERATION TYPE
-- MAY BE DECLARED IN ANOTHER ENUMERATION TYPE DEFINITION IN THE SAME
-- DECLARATIVE REGION.
 
-- R.WILLIAMS 8/20/86
-- GMT 6/30/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
--                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
--                       ADDED CODE FOR MY_PACK AND MY_FTN.
 
 
WITH REPORT; USE REPORT;
PROCEDURE C35102A IS
 
     TYPE E1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
     TYPE E2 IS ('A', 'C', RED, BLUE);
 
     PACKAGE  SHOW_TEST_HEADER  IS
              -- PURPOSE OF THIS PACKAGE:
              -- WE WANT THE TEST HEADER INFORMATION TO BE
              -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
     END SHOW_TEST_HEADER;
 
     PACKAGE  BODY  SHOW_TEST_HEADER  IS
     BEGIN
          TEST ( "C35102A",
                 "CHECK THAT AN ENUMERATION LITERAL BELONGING "   &
                 "TO ONE ENUMERATION TYPE MAY BE DECLARED IN "    &
                 "ANOTHER ENUMERATION TYPE DEFINITION IN THE "    &
                 "SAME DECLARATIVE REGION" );
     END SHOW_TEST_HEADER;
 
     FUNCTION  MY_FTN (  E : E1  ) RETURN  E2  IS
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN MY_FTN - 1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN MY_FTN - 1" );
          END IF;
 
          RETURN E2'VAL (  IDENT_INT ( E1'POS(E) )  );
     END MY_FTN;
 
 
     PACKAGE MY_PACK IS
     END MY_PACK;
 
     PACKAGE BODY MY_PACK IS
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
     BEGIN  -- MY_PACK
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN MY_PACK - 1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN MY_PACK - 1" );
          END IF;
     END MY_PACK;
 
     PACKAGE PKG IS
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
     END PKG;
 
     PACKAGE BODY PKG IS
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN PKG - 1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN PKG - 1" );
          END IF;
     END PKG;
 
     PACKAGE PRIV IS
          TYPE ENUM1 IS PRIVATE;
          TYPE ENUM2 IS PRIVATE;
 
          FUNCTION FE1 (E : E1) RETURN ENUM1;
 
          FUNCTION FE2 (E : E2) RETURN ENUM2;
 
     PRIVATE
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
     END PRIV;
 
     PACKAGE BODY PRIV IS
          FUNCTION FE1 (E : E1) RETURN ENUM1 IS
          BEGIN
               RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
          END FE1;
 
          FUNCTION FE2 (E : E2) RETURN ENUM2 IS
          BEGIN
               RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
          END FE2;
 
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN PRIV - 1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN PRIV - 1" );
          END IF;
     END PRIV;
 
     PACKAGE LPRIV IS
          TYPE ENUM1 IS LIMITED PRIVATE;
          TYPE ENUM2 IS LIMITED PRIVATE;
 
          FUNCTION FE1 (E : E1) RETURN ENUM1;
 
          FUNCTION FE2 (E : E2) RETURN ENUM2;
 
          FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN;
 
          FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN;
 
     PRIVATE
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
     END LPRIV;
 
     PACKAGE BODY LPRIV IS
          FUNCTION FE1 (E : E1) RETURN ENUM1 IS
          BEGIN
               RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
          END FE1;
 
          FUNCTION FE2 (E : E2) RETURN ENUM2 IS
          BEGIN
               RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
          END FE2;
 
          FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN IS
          BEGIN
               IF A = B THEN
                    RETURN TRUE;
               ELSE
                    RETURN FALSE;
               END IF;
          END EQUALS;
 
          FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN IS
          BEGIN
               IF A = B THEN
                    RETURN TRUE;
               ELSE
                    RETURN FALSE;
               END IF;
          END EQUALS;
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN LPRIV - 1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN LPRIV - 2" );
          END IF;
     END LPRIV;
 
     TASK T1;
 
     TASK BODY T1 IS
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN T1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN T1" );
          END IF;
     END T1;
 
     TASK T2 IS
          ENTRY E;
     END T2;
 
     TASK BODY T2 IS
     BEGIN
          ACCEPT E DO
               DECLARE
                    TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
                    TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
               BEGIN
                    IF ENUM2'SUCC ('A') /= 'C' THEN
                    FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                             "IN T2.E" );
                    END IF;
 
                    IF ENUM1'POS (RED) /= 3 THEN
                         FAILED ( "RED NOT DECLARED CORRECTLY IN " &
                                  "ENUM1 IN T2.E" );
                    END IF;
               END;
          END E;
     END T2;
 
     GENERIC
     PROCEDURE GP1;
 
     PROCEDURE GP1 IS
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN GP1" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN GP1" );
          END IF;
     END GP1;
 
     GENERIC
          TYPE E1 IS (<>);
          TYPE E2 IS (<>);
     PROCEDURE GP2;
 
     PROCEDURE GP2 IS
     BEGIN
          IF E2'SUCC (E2'VALUE ("'A'")) /= E2'VALUE ("'C'") THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN E2 " &
                        "IN GP2" );
          END IF;
 
          IF E1'POS (E1'VALUE ("RED")) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN E1 " &
                        "IN GP2" );
          END IF;
     END GP2;
 
     PROCEDURE NEWGP1 IS NEW GP1;
     PROCEDURE NEWGP2 IS NEW GP2 (E1, E2);
 
BEGIN
 
     DECLARE
          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
 
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN BLOCK" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN BLOCK" );
          END IF;
     END;
 
     DECLARE
          USE PKG;
     BEGIN
          IF ENUM2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN PKG - 2" );
          END IF;
 
          IF ENUM1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN PKG - 2" );
          END IF;
     END;
 
     DECLARE
          USE PRIV;
     BEGIN
          IF FE2 (E2'SUCC('A')) /= FE2 ('C') THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN PRIV - 2" );
          END IF;
 
          IF FE1 (RED) /= FE1 (E1'VAL (3)) THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN PRIV - 2" );
          END IF;
     END;
 
     DECLARE
          USE LPRIV;
     BEGIN
          IF NOT EQUALS (FE2 (E2'SUCC('A')), FE2 ('C')) THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
                        "IN LPRIV - 2" );
          END IF;
 
          IF NOT EQUALS (FE1 (RED), FE1 (E1'VAL (3))) THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
                        "IN LPRIV - 2" );
          END IF;
     END;
 
     BEGIN
          IF E2'SUCC ('A') /= 'C' THEN
               FAILED ( "'A' NOT DECLARED CORRECTLY IN E2" );
          END IF;
 
          IF E1'POS (RED) /= 3 THEN
               FAILED ( "RED NOT DECLARED CORRECTLY IN E1" );
          END IF;
     END;
 
     NEWGP1;
     NEWGP2;
     T2.E;
 
     RESULT;
END C35102A;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c35102a.ada] - Blame information for rev 720

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- C35102A.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 AN ENUMERATION LITERAL BELONGING TO ONE ENUMERATION TYPE`
26			`-- MAY BE DECLARED IN ANOTHER ENUMERATION TYPE DEFINITION IN THE SAME`
27			`-- DECLARATIVE REGION.`
28
29			`-- R.WILLIAMS 8/20/86`
30			`-- GMT 6/30/87 MOVED THE CALL TO REPORT.TEST INTO A NEWLY`
31			`-- CREATED PACKAGE NAMED SHOW_TEST_HEADER.`
32			`-- ADDED CODE FOR MY_PACK AND MY_FTN.`
33
34
35			`WITH REPORT; USE REPORT;`
36			`PROCEDURE C35102A IS`
37
38			`TYPE E1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
39			`TYPE E2 IS ('A', 'C', RED, BLUE);`
40
41			`PACKAGE SHOW_TEST_HEADER IS`
42			`-- PURPOSE OF THIS PACKAGE:`
43			`-- WE WANT THE TEST HEADER INFORMATION TO BE`
44			`-- PRINTED BEFORE ANY OF THE PASS/FAIL MESSAGES.`
45			`END SHOW_TEST_HEADER;`
46
47			`PACKAGE BODY SHOW_TEST_HEADER IS`
48			`BEGIN`
49			`TEST ( "C35102A",`
50			`"CHECK THAT AN ENUMERATION LITERAL BELONGING " &`
51			`"TO ONE ENUMERATION TYPE MAY BE DECLARED IN " &`
52			`"ANOTHER ENUMERATION TYPE DEFINITION IN THE " &`
53			`"SAME DECLARATIVE REGION" );`
54			`END SHOW_TEST_HEADER;`
55
56			`FUNCTION MY_FTN ( E : E1 ) RETURN E2 IS`
57			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
58			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
59			`BEGIN`
60			`IF ENUM2'SUCC ('A') /= 'C' THEN`
61			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
62			`"IN MY_FTN - 1" );`
63			`END IF;`
64
65			`IF ENUM1'POS (RED) /= 3 THEN`
66			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
67			`"IN MY_FTN - 1" );`
68			`END IF;`
69
70			`RETURN E2'VAL ( IDENT_INT ( E1'POS(E) ) );`
71			`END MY_FTN;`
72
73
74			`PACKAGE MY_PACK IS`
75			`END MY_PACK;`
76
77			`PACKAGE BODY MY_PACK IS`
78			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
79			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
80			`BEGIN -- MY_PACK`
81			`IF ENUM2'SUCC ('A') /= 'C' THEN`
82			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
83			`"IN MY_PACK - 1" );`
84			`END IF;`
85
86			`IF ENUM1'POS (RED) /= 3 THEN`
87			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
88			`"IN MY_PACK - 1" );`
89			`END IF;`
90			`END MY_PACK;`
91
92			`PACKAGE PKG IS`
93			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
94			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
95
96			`END PKG;`
97
98			`PACKAGE BODY PKG IS`
99			`BEGIN`
100			`IF ENUM2'SUCC ('A') /= 'C' THEN`
101			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
102			`"IN PKG - 1" );`
103			`END IF;`
104
105			`IF ENUM1'POS (RED) /= 3 THEN`
106			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
107			`"IN PKG - 1" );`
108			`END IF;`
109			`END PKG;`
110
111			`PACKAGE PRIV IS`
112			`TYPE ENUM1 IS PRIVATE;`
113			`TYPE ENUM2 IS PRIVATE;`
114
115			`FUNCTION FE1 (E : E1) RETURN ENUM1;`
116
117			`FUNCTION FE2 (E : E2) RETURN ENUM2;`
118
119			`PRIVATE`
120			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
121			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
122
123			`END PRIV;`
124
125			`PACKAGE BODY PRIV IS`
126			`FUNCTION FE1 (E : E1) RETURN ENUM1 IS`
127			`BEGIN`
128			`RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));`
129			`END FE1;`
130
131			`FUNCTION FE2 (E : E2) RETURN ENUM2 IS`
132			`BEGIN`
133			`RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));`
134			`END FE2;`
135
136			`BEGIN`
137			`IF ENUM2'SUCC ('A') /= 'C' THEN`
138			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
139			`"IN PRIV - 1" );`
140			`END IF;`
141
142			`IF ENUM1'POS (RED) /= 3 THEN`
143			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
144			`"IN PRIV - 1" );`
145			`END IF;`
146			`END PRIV;`
147
148			`PACKAGE LPRIV IS`
149			`TYPE ENUM1 IS LIMITED PRIVATE;`
150			`TYPE ENUM2 IS LIMITED PRIVATE;`
151
152			`FUNCTION FE1 (E : E1) RETURN ENUM1;`
153
154			`FUNCTION FE2 (E : E2) RETURN ENUM2;`
155
156			`FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN;`
157
158			`FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN;`
159
160			`PRIVATE`
161			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
162			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
163
164			`END LPRIV;`
165
166			`PACKAGE BODY LPRIV IS`
167			`FUNCTION FE1 (E : E1) RETURN ENUM1 IS`
168			`BEGIN`
169			`RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));`
170			`END FE1;`
171
172			`FUNCTION FE2 (E : E2) RETURN ENUM2 IS`
173			`BEGIN`
174			`RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));`
175			`END FE2;`
176
177			`FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN IS`
178			`BEGIN`
179			`IF A = B THEN`
180			`RETURN TRUE;`
181			`ELSE`
182			`RETURN FALSE;`
183			`END IF;`
184			`END EQUALS;`
185
186			`FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN IS`
187			`BEGIN`
188			`IF A = B THEN`
189			`RETURN TRUE;`
190			`ELSE`
191			`RETURN FALSE;`
192			`END IF;`
193			`END EQUALS;`
194			`BEGIN`
195			`IF ENUM2'SUCC ('A') /= 'C' THEN`
196			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
197			`"IN LPRIV - 1" );`
198			`END IF;`
199
200			`IF ENUM1'POS (RED) /= 3 THEN`
201			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
202			`"IN LPRIV - 2" );`
203			`END IF;`
204			`END LPRIV;`
205
206			`TASK T1;`
207
208			`TASK BODY T1 IS`
209			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
210			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
211
212			`BEGIN`
213			`IF ENUM2'SUCC ('A') /= 'C' THEN`
214			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
215			`"IN T1" );`
216			`END IF;`
217
218			`IF ENUM1'POS (RED) /= 3 THEN`
219			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
220			`"IN T1" );`
221			`END IF;`
222			`END T1;`
223
224			`TASK T2 IS`
225			`ENTRY E;`
226			`END T2;`
227
228			`TASK BODY T2 IS`
229			`BEGIN`
230			`ACCEPT E DO`
231			`DECLARE`
232			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
233			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
234
235			`BEGIN`
236			`IF ENUM2'SUCC ('A') /= 'C' THEN`
237			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
238			`"IN T2.E" );`
239			`END IF;`
240
241			`IF ENUM1'POS (RED) /= 3 THEN`
242			`FAILED ( "RED NOT DECLARED CORRECTLY IN " &`
243			`"ENUM1 IN T2.E" );`
244			`END IF;`
245			`END;`
246			`END E;`
247			`END T2;`
248
249			`GENERIC`
250			`PROCEDURE GP1;`
251
252			`PROCEDURE GP1 IS`
253			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
254			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
255
256			`BEGIN`
257			`IF ENUM2'SUCC ('A') /= 'C' THEN`
258			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
259			`"IN GP1" );`
260			`END IF;`
261
262			`IF ENUM1'POS (RED) /= 3 THEN`
263			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
264			`"IN GP1" );`
265			`END IF;`
266			`END GP1;`
267
268			`GENERIC`
269			`TYPE E1 IS (<>);`
270			`TYPE E2 IS (<>);`
271			`PROCEDURE GP2;`
272
273			`PROCEDURE GP2 IS`
274			`BEGIN`
275			`IF E2'SUCC (E2'VALUE ("'A'")) /= E2'VALUE ("'C'") THEN`
276			`FAILED ( "'A' NOT DECLARED CORRECTLY IN E2 " &`
277			`"IN GP2" );`
278			`END IF;`
279
280			`IF E1'POS (E1'VALUE ("RED")) /= 3 THEN`
281			`FAILED ( "RED NOT DECLARED CORRECTLY IN E1 " &`
282			`"IN GP2" );`
283			`END IF;`
284			`END GP2;`
285
286			`PROCEDURE NEWGP1 IS NEW GP1;`
287			`PROCEDURE NEWGP2 IS NEW GP2 (E1, E2);`
288
289			`BEGIN`
290
291			`DECLARE`
292			`TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);`
293			`TYPE ENUM2 IS ('A', 'C', RED, BLUE);`
294
295			`BEGIN`
296			`IF ENUM2'SUCC ('A') /= 'C' THEN`
297			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
298			`"IN BLOCK" );`
299			`END IF;`
300
301			`IF ENUM1'POS (RED) /= 3 THEN`
302			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
303			`"IN BLOCK" );`
304			`END IF;`
305			`END;`
306
307			`DECLARE`
308			`USE PKG;`
309			`BEGIN`
310			`IF ENUM2'SUCC ('A') /= 'C' THEN`
311			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
312			`"IN PKG - 2" );`
313			`END IF;`
314
315			`IF ENUM1'POS (RED) /= 3 THEN`
316			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
317			`"IN PKG - 2" );`
318			`END IF;`
319			`END;`
320
321			`DECLARE`
322			`USE PRIV;`
323			`BEGIN`
324			`IF FE2 (E2'SUCC('A')) /= FE2 ('C') THEN`
325			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
326			`"IN PRIV - 2" );`
327			`END IF;`
328
329			`IF FE1 (RED) /= FE1 (E1'VAL (3)) THEN`
330			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
331			`"IN PRIV - 2" );`
332			`END IF;`
333			`END;`
334
335			`DECLARE`
336			`USE LPRIV;`
337			`BEGIN`
338			`IF NOT EQUALS (FE2 (E2'SUCC('A')), FE2 ('C')) THEN`
339			`FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &`
340			`"IN LPRIV - 2" );`
341			`END IF;`
342
343			`IF NOT EQUALS (FE1 (RED), FE1 (E1'VAL (3))) THEN`
344			`FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &`
345			`"IN LPRIV - 2" );`
346			`END IF;`
347			`END;`
348
349			`BEGIN`
350			`IF E2'SUCC ('A') /= 'C' THEN`
351			`FAILED ( "'A' NOT DECLARED CORRECTLY IN E2" );`
352			`END IF;`
353
354			`IF E1'POS (RED) /= 3 THEN`
355			`FAILED ( "RED NOT DECLARED CORRECTLY IN E1" );`
356			`END IF;`
357			`END;`
358
359			`NEWGP1;`
360			`NEWGP2;`
361			`T2.E;`
362
363			`RESULT;`
364			`END C35102A;`