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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C37211B.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 CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 
26
-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
27
-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
28
-- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
29
-- PRIVATE TYPE, AND THE DISCRIMINANT CONSTRAINT OCCURS AFTER THE FULL 
30
-- DECLARATION OF THE TYPE.
31
 
32
-- R.WILLIAMS 8/28/86
33
-- EDS        7/14/98    AVOID OPTIMIZATION
34
 
35
WITH REPORT; USE REPORT;
36
PROCEDURE C37211B IS
37
 
38
     SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
39
 
40
     PACKAGE PKG IS
41
          TYPE PRIV (L : LIES) IS PRIVATE;
42
          TYPE LIM  (L : LIES) IS LIMITED PRIVATE;
43
 
44
     PRIVATE
45
          TYPE PRIV (L : LIES) IS
46
               RECORD
47
                    NULL;
48
               END RECORD;
49
 
50
          TYPE LIM (L : LIES) IS
51
               RECORD
52
                    NULL;
53
               END RECORD;
54
     END PKG;
55
 
56
     USE PKG;
57
 
58
BEGIN
59
     TEST ( "C37211B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
60
                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
61
                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
62
                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
63
                       "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
64
                       "PRIVATE TYPE, AND THE DISCRIMINANT " &
65
                       "CONSTRAINT OCCURS AFTER THE FULL " &
66
                       "DECLARATION OF THE TYPE" );
67
 
68
     BEGIN
69
          DECLARE
70
               SUBTYPE SUBPRIV IS PRIV (IDENT_BOOL (TRUE));
71
          BEGIN
72
               DECLARE
73
                    SP : SUBPRIV;
74
               BEGIN
75
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
76
                             "ELABORATION OF SUBTYPE SUBPRIV " &
77
                             BOOLEAN'IMAGE(SP.L));
78
               END;
79
          EXCEPTION
80
               WHEN OTHERS =>
81
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
82
                             "OBJECT SP" );
83
          END;
84
 
85
     EXCEPTION
86
          WHEN CONSTRAINT_ERROR =>
87
               NULL;
88
          WHEN OTHERS =>
89
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
90
                        "SUBTYPE SUBPRIV" );
91
     END;
92
 
93
     BEGIN
94
          DECLARE
95
               SUBTYPE SUBLIM IS LIM (IDENT_BOOL (TRUE));
96
          BEGIN
97
               DECLARE
98
                    SL : SUBLIM;
99
               BEGIN
100
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
101
                             "ELABORATION OF SUBTYPE SUBLIM" &
102
                             BOOLEAN'IMAGE(SL.L));
103
               END;
104
          EXCEPTION
105
               WHEN OTHERS =>
106
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
107
                             "OBJECT SL " );
108
          END;
109
 
110
     EXCEPTION
111
          WHEN CONSTRAINT_ERROR =>
112
               NULL;
113
          WHEN OTHERS =>
114
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
115
                        "SUBTYPE SUBLIM" );
116
     END;
117
 
118
     BEGIN
119
          DECLARE
120
               TYPE PARR IS ARRAY (1 .. 5) OF PRIV (IDENT_BOOL (TRUE));
121
          BEGIN
122
               DECLARE
123
                    PAR : PARR;
124
               BEGIN
125
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
126
                             "ELABORATION OF TYPE PARR " &
127
                             BOOLEAN'IMAGE(PAR(1).L));
128
               END;
129
          EXCEPTION
130
               WHEN OTHERS =>
131
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
132
                             "OBJECT PAR" );
133
          END;
134
 
135
     EXCEPTION
136
          WHEN CONSTRAINT_ERROR =>
137
               NULL;
138
          WHEN OTHERS =>
139
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
140
                        "TYPE PARR" );
141
     END;
142
 
143
     BEGIN
144
          DECLARE
145
               TYPE LARR IS ARRAY (1 .. 10) OF LIM (IDENT_BOOL (TRUE));
146
          BEGIN
147
               DECLARE
148
                    LAR : LARR;
149
               BEGIN
150
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
151
                             "ELABORATION OF TYPE LARR " &
152
                             BOOLEAN'IMAGE(LAR(1).L));
153
               END;
154
          EXCEPTION
155
               WHEN OTHERS =>
156
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
157
                             "OBJECT LAR" );
158
          END;
159
 
160
     EXCEPTION
161
          WHEN CONSTRAINT_ERROR =>
162
               NULL;
163
          WHEN OTHERS =>
164
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
165
                        "TYPE LARR" );
166
     END;
167
 
168
     BEGIN
169
          DECLARE
170
               TYPE PRIV1 IS
171
                    RECORD
172
                         X : PRIV (IDENT_BOOL (TRUE));
173
                    END RECORD;
174
 
175
          BEGIN
176
               DECLARE
177
                    P1 : PRIV1;
178
               BEGIN
179
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
180
                             "ELABORATION OF TYPE PRIV1 " &
181
                             BOOLEAN'IMAGE(P1.X.L));
182
               END;
183
          EXCEPTION
184
               WHEN OTHERS =>
185
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
186
                             "OBJECT P1" );
187
          END;
188
 
189
     EXCEPTION
190
          WHEN CONSTRAINT_ERROR =>
191
               NULL;
192
          WHEN OTHERS =>
193
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
194
                        "TYPE PRIV1" );
195
     END;
196
 
197
     BEGIN
198
          DECLARE
199
               TYPE LIM1 IS
200
                    RECORD
201
                         X : LIM (IDENT_BOOL (TRUE));
202
                    END RECORD;
203
 
204
          BEGIN
205
               DECLARE
206
                    L1 : LIM1;
207
               BEGIN
208
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
209
                             "ELABORATION OF TYPE LIM1 " &
210
                             BOOLEAN'IMAGE(L1.X.L));
211
               END;
212
          EXCEPTION
213
               WHEN OTHERS =>
214
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
215
                             "OBJECT L1" );
216
          END;
217
 
218
     EXCEPTION
219
          WHEN CONSTRAINT_ERROR =>
220
               NULL;
221
          WHEN OTHERS =>
222
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
223
                        "TYPE LIM1" );
224
     END;
225
 
226
     BEGIN
227
          DECLARE
228
               TYPE ACCPRIV IS ACCESS PRIV (IDENT_BOOL (TRUE));
229
          BEGIN
230
               DECLARE
231
                    ACP : ACCPRIV;
232
               BEGIN
233
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
234
                             "ELABORATION OF TYPE ACCPRIV " &
235
                             BOOLEAN'IMAGE(ACP.L));
236
               END;
237
          EXCEPTION
238
               WHEN OTHERS =>
239
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
240
                             "OBJECT ACP" );
241
          END;
242
 
243
     EXCEPTION
244
          WHEN CONSTRAINT_ERROR =>
245
               NULL;
246
          WHEN OTHERS =>
247
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
248
                        "TYPE ACCPRIV" );
249
     END;
250
 
251
     BEGIN
252
          DECLARE
253
               TYPE ACCLIM IS ACCESS LIM (IDENT_BOOL (TRUE));
254
          BEGIN
255
               DECLARE
256
                    ACL : ACCLIM;
257
               BEGIN
258
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
259
                             "ELABORATION OF TYPE ACCLIM " &
260
                             BOOLEAN'IMAGE(ACL.L));
261
               END;
262
          EXCEPTION
263
               WHEN OTHERS =>
264
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
265
                             "OBJECT ACL" );
266
          END;
267
 
268
     EXCEPTION
269
          WHEN CONSTRAINT_ERROR =>
270
               NULL;
271
          WHEN OTHERS =>
272
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
273
                        "TYPE ACCLIM" );
274
     END;
275
 
276
     BEGIN
277
          DECLARE
278
               TYPE NEWPRIV IS NEW PRIV (IDENT_BOOL (TRUE));
279
          BEGIN
280
               DECLARE
281
                    NP : NEWPRIV;
282
               BEGIN
283
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
284
                             "ELABORATION OF TYPE NEWPRIV " &
285
                             BOOLEAN'IMAGE(NP.L));
286
               END;
287
          EXCEPTION
288
               WHEN OTHERS =>
289
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
290
                             "OBJECT NP" );
291
          END;
292
 
293
     EXCEPTION
294
          WHEN CONSTRAINT_ERROR =>
295
               NULL;
296
          WHEN OTHERS =>
297
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
298
                        "TYPE NEWPRIV" );
299
     END;
300
 
301
     BEGIN
302
          DECLARE
303
               TYPE NEWLIM IS NEW LIM (IDENT_BOOL (TRUE));
304
          BEGIN
305
               DECLARE
306
                    NL : NEWLIM;
307
               BEGIN
308
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
309
                             "ELABORATION OF TYPE NEWLIM " &
310
                             BOOLEAN'IMAGE(NL.L));
311
               END;
312
          EXCEPTION
313
               WHEN OTHERS =>
314
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
315
                             "OBJECT NL" );
316
          END;
317
 
318
     EXCEPTION
319
          WHEN CONSTRAINT_ERROR =>
320
               NULL;
321
          WHEN OTHERS =>
322
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
323
                        "TYPE NEWLIM" );
324
     END;
325
 
326
     BEGIN
327
          DECLARE
328
               P : PRIV (IDENT_BOOL (TRUE));
329
          BEGIN
330
               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
331
                        "P " & BOOLEAN'IMAGE(P.L));
332
          EXCEPTION
333
               WHEN OTHERS =>
334
                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
335
                             "CONTAINING P" );
336
          END;
337
 
338
     EXCEPTION
339
          WHEN CONSTRAINT_ERROR =>
340
               NULL;
341
          WHEN OTHERS =>
342
               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
343
                        "P" );
344
     END;
345
 
346
     BEGIN
347
          DECLARE
348
               L : LIM (IDENT_BOOL (TRUE));
349
          BEGIN
350
               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
351
                        "L " & BOOLEAN'IMAGE(L.L));
352
          EXCEPTION
353
               WHEN OTHERS =>
354
                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
355
                             "CONTAINING L" );
356
          END;
357
 
358
     EXCEPTION
359
          WHEN CONSTRAINT_ERROR =>
360
               NULL;
361
          WHEN OTHERS =>
362
               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
363
                        "L" );
364
     END;
365
 
366
     BEGIN
367
          DECLARE
368
               TYPE PRIV_NAME IS ACCESS PRIV;
369
          BEGIN
370
               DECLARE
371
                    PN : PRIV_NAME := NEW PRIV (IDENT_BOOL (TRUE));
372
               BEGIN
373
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
374
                             "DECLARATION OF OBJECT PN " &
375
                             BOOLEAN'IMAGE(PN.L));
376
               EXCEPTION
377
                    WHEN OTHERS =>
378
                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
379
               END;
380
          EXCEPTION
381
               WHEN CONSTRAINT_ERROR =>
382
                    NULL;
383
               WHEN OTHERS =>
384
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
385
                             "OF OBJECT PN" );
386
          END;
387
     EXCEPTION
388
          WHEN OTHERS =>
389
               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
390
                        "PRIV_NAME" );
391
     END;
392
 
393
     BEGIN
394
          DECLARE
395
               TYPE LIM_NAME IS ACCESS LIM;
396
          BEGIN
397
               DECLARE
398
                    LN : LIM_NAME := NEW LIM (IDENT_BOOL (TRUE));
399
               BEGIN
400
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
401
                             "DECLARATION OF OBJECT LN " &
402
                             BOOLEAN'IMAGE(LN.L));
403
               EXCEPTION
404
                    WHEN OTHERS =>
405
                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
406
               END;
407
          EXCEPTION
408
               WHEN CONSTRAINT_ERROR =>
409
                    NULL;
410
               WHEN OTHERS =>
411
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
412
                             "OF OBJECT LN" );
413
          END;
414
     EXCEPTION
415
          WHEN OTHERS =>
416
               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
417
                        "LIM_NAME" );
418
     END;
419
 
420
     BEGIN
421
          DECLARE
422
               PACKAGE PP IS
423
                    TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
424
                         PRIVATE;
425
               PRIVATE
426
                    TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
427
                         RECORD
428
                              NULL;
429
                         END RECORD;
430
               END PP;
431
 
432
               USE PP;
433
          BEGIN
434
               DECLARE
435
                    BP : BAD_PRIV;
436
               BEGIN
437
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
438
                             "DECLARATION OF OBJECT BP " &
439
                             BOOLEAN'IMAGE(BP.D));
440
               EXCEPTION
441
                    WHEN OTHERS =>
442
                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
443
               END;
444
          EXCEPTION
445
               WHEN CONSTRAINT_ERROR =>
446
                    NULL;
447
               WHEN OTHERS =>
448
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
449
                             "OF OBJECT BP" );
450
          END;
451
     EXCEPTION
452
          WHEN OTHERS =>
453
               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
454
                        "BAD_PRIV" );
455
     END;
456
 
457
     BEGIN
458
          DECLARE
459
               PACKAGE PL IS
460
                    TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
461
                         LIMITED PRIVATE;
462
               PRIVATE
463
                    TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
464
                         RECORD
465
                              NULL;
466
                         END RECORD;
467
               END PL;
468
 
469
               USE PL;
470
          BEGIN
471
               DECLARE
472
                    BL : BAD_LIM;
473
               BEGIN
474
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
475
                             "DECLARATION OF OBJECT BL " &
476
                             BOOLEAN'IMAGE(BL.D));
477
               EXCEPTION
478
                    WHEN OTHERS =>
479
                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
480
               END;
481
          EXCEPTION
482
               WHEN CONSTRAINT_ERROR =>
483
                    NULL;
484
               WHEN OTHERS =>
485
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
486
                             "OF OBJECT BL" );
487
          END;
488
     EXCEPTION
489
          WHEN OTHERS =>
490
               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
491
                        "BAD_LIM" );
492
     END;
493
 
494
     RESULT;
495
END C37211B;

powered by: WebSVN 2.1.0

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