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

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

Line No. Rev Author Line
1 294 jeremybenn
-- C32113A.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 WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED TYPE
27
--     WITH DISCRIMINANTS IS DECLARED WITH AN INITIAL VALUE,
28
--     CONSTRAINT_ERROR IS RAISED IF THE CORRESPONDING DISCRIMINANTS OF
29
--     THE INITIAL VALUE AND THE SUBTYPE DO NOT HAVE THE SAME VALUE.
30
 
31
-- HISTORY:
32
--     RJW 07/20/86
33
--     DWC 06/22/87  ADDED SUBTYPE PRIVAS.  ADDED CODE TO PREVENT DEAD
34
--                   VARIABLE OPTIMIZATION.
35
 
36
WITH REPORT; USE REPORT;
37
 
38
PROCEDURE C32113A IS
39
 
40
     PACKAGE PKG IS
41
          TYPE PRIVA (D : INTEGER := 0) IS PRIVATE;
42
          SUBTYPE PRIVAS IS PRIVA (IDENT_INT (1));
43
          PRA1 : CONSTANT PRIVAS;
44
 
45
          TYPE PRIVB (D1, D2 : INTEGER) IS PRIVATE;
46
          PRB12 : CONSTANT PRIVB;
47
 
48
     PRIVATE
49
          TYPE PRIVA (D : INTEGER := 0) IS
50
               RECORD
51
                    NULL;
52
               END RECORD;
53
 
54
          TYPE PRIVB (D1, D2 : INTEGER) IS
55
               RECORD
56
                     NULL;
57
               END RECORD;
58
 
59
          PRA1  : CONSTANT PRIVAS := (D => (IDENT_INT (1)));
60
          PRB12 : CONSTANT PRIVB := (IDENT_INT (1), IDENT_INT (2));
61
     END PKG;
62
 
63
     USE PKG;
64
 
65
     TYPE RECA (D : INTEGER := 0) IS
66
          RECORD
67
               NULL;
68
          END RECORD;
69
 
70
     TYPE RECB (D1, D2 : INTEGER) IS
71
          RECORD
72
               NULL;
73
          END RECORD;
74
 
75
     RA1 : CONSTANT RECA (IDENT_INT (1)) := (D => (IDENT_INT (1)));
76
 
77
     RB12 : CONSTANT RECB := (IDENT_INT (1), IDENT_INT (2));
78
 
79
BEGIN
80
     TEST ("C32113A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
81
                      "HAVING A CONSTRAINED TYPE IS DECLARED WITH " &
82
                      "AN INITIAL VALUE, CONSTRAINT_ERROR IS " &
83
                      "RAISED IF THE CORRESPONDING DISCRIMINANTS " &
84
                      "OF THE INITIAL VALUE AND THE SUBTYPE DO " &
85
                      "NOT HAVE THE SAME VALUE" );
86
 
87
     BEGIN
88
          DECLARE
89
               PR1 : CONSTANT PRIVA (IDENT_INT (0)) := PRA1;
90
          BEGIN
91
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
92
                        "OF CONSTANT 'PR1'" );
93
               IF PR1 = PRA1 THEN
94
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
95
               END IF;
96
          END;
97
     EXCEPTION
98
          WHEN CONSTRAINT_ERROR =>
99
               NULL;
100
          WHEN OTHERS =>
101
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
102
                        "OF CONSTANT 'PR1'" );
103
     END;
104
 
105
     BEGIN
106
          DECLARE
107
               PR2 : CONSTANT PRIVA (IDENT_INT (2)) := PRA1;
108
          BEGIN
109
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
110
                        "OF CONSTANT 'PR2'" );
111
               IF PR2 = PRA1 THEN
112
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
113
               END IF;
114
          END;
115
     EXCEPTION
116
          WHEN CONSTRAINT_ERROR =>
117
               NULL;
118
          WHEN OTHERS =>
119
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
120
                        "OF CONSTANT 'PR2'" );
121
     END;
122
 
123
     BEGIN
124
          DECLARE
125
               PR3 : PRIVA (IDENT_INT (0)) := PRA1;
126
          BEGIN
127
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
128
                        "OF VARIABLE 'PR3'" );
129
               IF PR3 = PRA1 THEN
130
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
131
               END IF;
132
          END;
133
     EXCEPTION
134
          WHEN CONSTRAINT_ERROR =>
135
               NULL;
136
          WHEN OTHERS =>
137
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
138
                        "OF VARIABLE 'PR3'" );
139
     END;
140
 
141
     BEGIN
142
          DECLARE
143
               PR4 : PRIVA (IDENT_INT (2)) := PRA1;
144
          BEGIN
145
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
146
                        "OF VARIABLE 'PR4'" );
147
               IF PR4 = PRA1 THEN
148
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
149
               END IF;
150
          END;
151
     EXCEPTION
152
          WHEN CONSTRAINT_ERROR =>
153
               NULL;
154
          WHEN OTHERS =>
155
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
156
                        "OF VARIABLE 'PR4'" );
157
     END;
158
 
159
     BEGIN
160
          DECLARE
161
               SUBTYPE SPRIVA IS PRIVA (IDENT_INT (-1));
162
               PR5 : CONSTANT SPRIVA := PRA1;
163
          BEGIN
164
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
165
                        "OF CONSTANT 'PR5'" );
166
               IF PR5 = PRA1 THEN
167
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
168
               END IF;
169
          END;
170
     EXCEPTION
171
          WHEN CONSTRAINT_ERROR =>
172
               NULL;
173
          WHEN OTHERS =>
174
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
175
                        "OF CONSTANT 'PR5'" );
176
     END;
177
 
178
     BEGIN
179
          DECLARE
180
               SUBTYPE SPRIVA IS PRIVA (IDENT_INT (3));
181
               PR6 : SPRIVA := PRA1;
182
          BEGIN
183
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
184
                        "OF VARIABLE 'PR6'" );
185
               IF PR6 = PRA1 THEN
186
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
187
               END IF;
188
          END;
189
     EXCEPTION
190
          WHEN CONSTRAINT_ERROR =>
191
               NULL;
192
          WHEN OTHERS =>
193
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
194
                        "OF VARIABLE 'PR6'" );
195
     END;
196
 
197
     BEGIN
198
          DECLARE
199
               PR7 : CONSTANT PRIVB (IDENT_INT (1), IDENT_INT (1)) :=
200
                     PRB12;
201
          BEGIN
202
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
203
                        "OF CONSTANT 'PR7'" );
204
               IF PR7 = PRB12 THEN
205
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
206
               END IF;
207
          END;
208
     EXCEPTION
209
          WHEN CONSTRAINT_ERROR =>
210
               NULL;
211
          WHEN OTHERS =>
212
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
213
                        "OF CONSTANT 'PR7'" );
214
     END;
215
 
216
     BEGIN
217
          DECLARE
218
               PR8 : CONSTANT PRIVB (IDENT_INT (2), IDENT_INT (2)) :=
219
                     PRB12;
220
          BEGIN
221
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
222
                        "OF CONSTANT 'PR8'" );
223
               IF PR8 = PRB12 THEN
224
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
225
               END IF;
226
          END;
227
     EXCEPTION
228
          WHEN CONSTRAINT_ERROR =>
229
               NULL;
230
          WHEN OTHERS =>
231
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
232
                        "OF CONSTANT 'PR8'" );
233
     END;
234
 
235
     BEGIN
236
          DECLARE
237
               PR9 : PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12;
238
          BEGIN
239
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
240
                        "OF VARIABLE 'PR9'" );
241
               IF PR9 = PRB12 THEN
242
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
243
               END IF;
244
          END;
245
     EXCEPTION
246
          WHEN CONSTRAINT_ERROR =>
247
               NULL;
248
          WHEN OTHERS =>
249
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
250
                        "OF VARIABLE 'PR9'" );
251
     END;
252
 
253
     BEGIN
254
          DECLARE
255
               PR10 : PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12;
256
          BEGIN
257
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
258
                        "OF VARIABLE 'PR10'" );
259
               IF PR10 = PRB12 THEN
260
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
261
               END IF;
262
          END;
263
     EXCEPTION
264
          WHEN CONSTRAINT_ERROR =>
265
               NULL;
266
          WHEN OTHERS =>
267
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
268
                        "OF VARIABLE 'PR10'" );
269
     END;
270
 
271
     BEGIN
272
          DECLARE
273
               SUBTYPE SPRIVB IS
274
                       PRIVB (IDENT_INT (-1), IDENT_INT (-2));
275
               PR11 : CONSTANT SPRIVB := PRB12;
276
          BEGIN
277
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
278
                        "OF CONSTANT 'PR11'" );
279
               IF PR11 = PRB12 THEN
280
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
281
               END IF;
282
          END;
283
     EXCEPTION
284
          WHEN CONSTRAINT_ERROR =>
285
               NULL;
286
          WHEN OTHERS =>
287
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
288
                        "OF CONSTANT 'PR11'" );
289
     END;
290
 
291
     BEGIN
292
          DECLARE
293
               SUBTYPE SPRIVB IS PRIVB (IDENT_INT (2), IDENT_INT (1));
294
               PR12 : SPRIVB := PRB12;
295
          BEGIN
296
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
297
                        "OF VARIABLE 'PR12'" );
298
               IF PR12 = PRB12 THEN
299
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
300
               END IF;
301
          END;
302
     EXCEPTION
303
          WHEN CONSTRAINT_ERROR =>
304
               NULL;
305
          WHEN OTHERS =>
306
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
307
                        "OF VARIABLE 'PR12'" );
308
     END;
309
 
310
     BEGIN
311
          DECLARE
312
               R1 : CONSTANT RECA (IDENT_INT (0)) := RA1;
313
          BEGIN
314
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
315
                        "OF CONSTANT 'R1'" );
316
               IF R1 = RA1 THEN
317
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
318
               END IF;
319
          END;
320
     EXCEPTION
321
          WHEN CONSTRAINT_ERROR =>
322
               NULL;
323
          WHEN OTHERS =>
324
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
325
                        "OF CONSTANT 'R1'" );
326
     END;
327
 
328
     BEGIN
329
          DECLARE
330
               R2 : CONSTANT RECA (IDENT_INT (2)) := RA1;
331
          BEGIN
332
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
333
                        "OF CONSTANT 'R2'" );
334
               IF R2 = RA1 THEN
335
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
336
               END IF;
337
          END;
338
     EXCEPTION
339
          WHEN CONSTRAINT_ERROR =>
340
               NULL;
341
          WHEN OTHERS =>
342
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
343
                        "OF CONSTANT 'R2'" );
344
     END;
345
 
346
     BEGIN
347
          DECLARE
348
               R3 : RECA (IDENT_INT (0)) := RA1;
349
          BEGIN
350
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
351
                        "OF VARIABLE 'R3'" );
352
               IF R3 = RA1 THEN
353
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
354
               END IF;
355
          END;
356
     EXCEPTION
357
          WHEN CONSTRAINT_ERROR =>
358
               NULL;
359
          WHEN OTHERS =>
360
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
361
                        "OF VARIABLE 'R3'" );
362
     END;
363
 
364
     BEGIN
365
          DECLARE
366
               R4 : RECA (IDENT_INT (2)) := RA1;
367
          BEGIN
368
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
369
                        "OF VARIABLE 'R4'" );
370
               IF R4 = RA1 THEN
371
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
372
               END IF;
373
          END;
374
     EXCEPTION
375
          WHEN CONSTRAINT_ERROR =>
376
               NULL;
377
          WHEN OTHERS =>
378
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
379
                        "OF VARIABLE 'R4'" );
380
     END;
381
 
382
     BEGIN
383
          DECLARE
384
               SUBTYPE SRECA IS RECA (IDENT_INT (-1));
385
               R5 : CONSTANT SRECA := RA1;
386
          BEGIN
387
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
388
                        "OF CONSTANT 'R5'" );
389
               IF R5 = RA1 THEN
390
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
391
               END IF;
392
          END;
393
     EXCEPTION
394
          WHEN CONSTRAINT_ERROR =>
395
               NULL;
396
          WHEN OTHERS =>
397
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
398
                        "OF CONSTANT 'R5'" );
399
     END;
400
 
401
     BEGIN
402
          DECLARE
403
               SUBTYPE SRECA IS RECA (IDENT_INT (3));
404
               R6 : SRECA := RA1;
405
          BEGIN
406
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
407
                        "OF VARIABLE 'R6'" );
408
               IF R6 = RA1 THEN
409
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
410
               END IF;
411
          END;
412
     EXCEPTION
413
          WHEN CONSTRAINT_ERROR =>
414
               NULL;
415
          WHEN OTHERS =>
416
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
417
                        "OF VARIABLE 'R6'" );
418
     END;
419
 
420
     BEGIN
421
          DECLARE
422
               R7 : CONSTANT RECB (IDENT_INT (1), IDENT_INT (1)) :=
423
                     RB12;
424
          BEGIN
425
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
426
                        "OF CONSTANT 'R7'" );
427
               IF R7 = RB12 THEN
428
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
429
               END IF;
430
          END;
431
     EXCEPTION
432
          WHEN CONSTRAINT_ERROR =>
433
               NULL;
434
          WHEN OTHERS =>
435
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
436
                        "OF CONSTANT 'R7'" );
437
     END;
438
 
439
     BEGIN
440
          DECLARE
441
               R8 : CONSTANT RECB (IDENT_INT (2), IDENT_INT (2)) :=
442
                     RB12;
443
          BEGIN
444
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
445
                        "OF CONSTANT 'R8'" );
446
               IF R8 = RB12 THEN
447
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
448
               END IF;
449
          END;
450
     EXCEPTION
451
          WHEN CONSTRAINT_ERROR =>
452
               NULL;
453
          WHEN OTHERS =>
454
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
455
                        "OF CONSTANT 'R8'" );
456
     END;
457
 
458
     BEGIN
459
          DECLARE
460
               R9 : RECB (IDENT_INT (1), IDENT_INT (1)) := RB12;
461
          BEGIN
462
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
463
                        "OF VARIABLE 'R9'" );
464
               IF R9 = RB12 THEN
465
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
466
               END IF;
467
          END;
468
     EXCEPTION
469
          WHEN CONSTRAINT_ERROR =>
470
               NULL;
471
          WHEN OTHERS =>
472
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
473
                        "OF VARIABLE 'R9'" );
474
     END;
475
 
476
     BEGIN
477
          DECLARE
478
               R10 : RECB (IDENT_INT (2), IDENT_INT (2)) := RB12;
479
          BEGIN
480
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
481
                        "OF VARIABLE 'R10'" );
482
               IF R10 = RB12 THEN
483
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
484
               END IF;
485
          END;
486
     EXCEPTION
487
          WHEN CONSTRAINT_ERROR =>
488
               NULL;
489
          WHEN OTHERS =>
490
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
491
                        "OF VARIABLE 'R10'" );
492
     END;
493
 
494
     BEGIN
495
          DECLARE
496
               SUBTYPE SRECB IS
497
                       RECB (IDENT_INT (-1), IDENT_INT (-2));
498
               R11 : CONSTANT SRECB := RB12;
499
          BEGIN
500
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
501
                        "OF CONSTANT 'R11'" );
502
               IF R11 = RB12 THEN
503
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
504
               END IF;
505
          END;
506
     EXCEPTION
507
          WHEN CONSTRAINT_ERROR =>
508
               NULL;
509
          WHEN OTHERS =>
510
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
511
                        "OF CONSTANT 'R11'" );
512
     END;
513
 
514
     BEGIN
515
          DECLARE
516
               SUBTYPE SRECB IS RECB (IDENT_INT (2), IDENT_INT (1));
517
               R12 : SRECB := RB12;
518
          BEGIN
519
               FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
520
                        "OF VARIABLE 'R12'" );
521
               IF R12 = RB12 THEN
522
                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
523
               END IF;
524
          END;
525
     EXCEPTION
526
          WHEN CONSTRAINT_ERROR =>
527
               NULL;
528
          WHEN OTHERS =>
529
               FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
530
                        "OF VARIABLE 'R12'" );
531
     END;
532
 
533
     RESULT;
534
END C32113A;

powered by: WebSVN 2.1.0

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