OpenCores
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/] [c35102a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.