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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC3017B.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 INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
26
-- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
27
-- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
28
-- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
29
-- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE     
30
-- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.   
31
 
32
--   SUBTESTS ARE:
33
--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
34
--            INITIALIZED WITH A STATIC AGGREGATE.
35
--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
36
--            INITIALIZED WITH A STATIC VALUE.
37
--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
38
--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
39
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
40
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
41
--            WITH A STATIC AGGREGATE.
42
--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
43
--            INITIALIZED WITH A STATIC AGGREGATE.
44
 
45
-- EDWARD V. BERARD, 7 AUGUST 1990
46
 
47
WITH REPORT;
48
 
49
PROCEDURE CC3017B IS
50
 
51
BEGIN
52
 
53
     REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
54
                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
55
                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
56
                  "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
57
                  "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
58
                  "CONSTRAINTS ON A FORMAL PARAMETER");
59
 
60
     --------------------------------------------------
61
 
62
     NONSTAT_ARRAY_PARMS:
63
 
64
     DECLARE
65
 
66
--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
67
--            INITIALIZED WITH A STATIC AGGREGATE.
68
 
69
          TYPE NUMBER IS RANGE 1 .. 100 ;
70
 
71
          GENERIC
72
 
73
            TYPE INTEGER_TYPE IS RANGE <> ;
74
            LOWER : IN INTEGER_TYPE ;
75
            UPPER : IN INTEGER_TYPE ;
76
 
77
          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
78
                        SECOND : IN INTEGER_TYPE) ;
79
 
80
          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
81
                        SECOND : IN INTEGER_TYPE) IS
82
 
83
               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
84
                                 INTEGER_TYPE RANGE LOWER .. SECOND)
85
                                         OF INTEGER_TYPE;
86
 
87
               PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
88
                    IS
89
               BEGIN
90
                    REPORT.FAILED ("BODY OF PA1 EXECUTED");
91
               EXCEPTION
92
                    WHEN OTHERS =>
93
                         REPORT.FAILED ("EXCEPTION RAISED IN PA1");
94
               END PA1;
95
 
96
          BEGIN  -- PA
97
               PA1;
98
          EXCEPTION
99
               WHEN CONSTRAINT_ERROR =>
100
                    NULL;
101
               WHEN OTHERS =>
102
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
103
          END PA;
104
 
105
          PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
106
                                      LOWER        => 1,
107
                                      UPPER        => 50) ;
108
 
109
     BEGIN   -- NONSTAT_ARRAY_PARMS
110
 
111
          NEW_PA (FIRST  => NUMBER (25),
112
                  SECOND => NUMBER (75));
113
 
114
     EXCEPTION
115
          WHEN OTHERS =>
116
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
117
 
118
     END NONSTAT_ARRAY_PARMS ;
119
 
120
     --------------------------------------------------
121
 
122
     SCALAR_NON_STATIC:
123
 
124
     DECLARE
125
 
126
--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
127
--            INITIALIZED WITH A STATIC VALUE.
128
 
129
          TYPE NUMBER IS RANGE 1 .. 100 ;
130
 
131
          GENERIC
132
 
133
            TYPE INTEGER_TYPE IS RANGE <> ;
134
            STATIC_VALUE : IN INTEGER_TYPE ;
135
 
136
          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
137
                        UPPER  : IN INTEGER_TYPE) ;
138
 
139
          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
140
                        UPPER  : IN INTEGER_TYPE) IS
141
 
142
               SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
143
 
144
               PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
145
               BEGIN  -- PB1
146
                    REPORT.FAILED ("BODY OF PB1 EXECUTED");
147
               EXCEPTION
148
                    WHEN OTHERS =>
149
                         REPORT.FAILED ("EXCEPTION RAISED IN PB1");
150
               END PB1;
151
 
152
          BEGIN  -- PB
153
               PB1;
154
          EXCEPTION
155
               WHEN CONSTRAINT_ERROR =>
156
                    NULL;
157
               WHEN OTHERS =>
158
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
159
          END PB;
160
 
161
          PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
162
                                      STATIC_VALUE => 20) ;
163
 
164
     BEGIN   -- SCALAR_NON_STATIC
165
 
166
          NEW_PB (LOWER  => NUMBER (25),
167
                  UPPER  => NUMBER (75));
168
 
169
     EXCEPTION
170
          WHEN OTHERS =>
171
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
172
     END SCALAR_NON_STATIC ;
173
 
174
     --------------------------------------------------
175
 
176
     REC_NON_STAT_COMPS:
177
 
178
     DECLARE
179
 
180
--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
181
--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
182
 
183
          TYPE NUMBER IS RANGE 1 .. 100 ;
184
 
185
          GENERIC
186
 
187
            TYPE INTEGER_TYPE IS RANGE <> ;
188
            F_STATIC_VALUE : IN INTEGER_TYPE ;
189
            S_STATIC_VALUE : IN INTEGER_TYPE ;
190
            T_STATIC_VALUE : IN INTEGER_TYPE ;
191
            L_STATIC_VALUE : IN INTEGER_TYPE ;
192
 
193
          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
194
                        UPPER  : IN INTEGER_TYPE) ;
195
 
196
          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
197
                        UPPER  : IN INTEGER_TYPE) IS
198
 
199
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
200
                       RANGE LOWER .. UPPER ;
201
               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF
202
                     SUBINTEGER_TYPE ;
203
               TYPE REC IS
204
                    RECORD
205
                         FIRST  : SUBINTEGER_TYPE ;
206
                         SECOND : AR1 ;
207
                    END RECORD;
208
 
209
               PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
210
                                         (S_STATIC_VALUE,
211
                                          T_STATIC_VALUE,
212
                                          L_STATIC_VALUE))) IS
213
               BEGIN  -- PC1
214
                    REPORT.FAILED ("BODY OF PC1 EXECUTED");
215
               EXCEPTION
216
                    WHEN OTHERS =>
217
                         REPORT.FAILED ("EXCEPTION RAISED IN PC1");
218
               END PC1;
219
 
220
          BEGIN  -- PC
221
               PC1;
222
          EXCEPTION
223
               WHEN CONSTRAINT_ERROR =>
224
                    NULL;
225
               WHEN OTHERS =>
226
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
227
          END PC;
228
 
229
          PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
230
                                      F_STATIC_VALUE => 15,
231
                                      S_STATIC_VALUE => 19,
232
                                      T_STATIC_VALUE => 85,
233
                                      L_STATIC_VALUE => 99) ;
234
 
235
     BEGIN   -- REC_NON_STAT_COMPS
236
          NEW_PC (LOWER => 20,
237
                  UPPER => 80);
238
     EXCEPTION
239
          WHEN OTHERS =>
240
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
241
     END REC_NON_STAT_COMPS ;
242
 
243
     --------------------------------------------------
244
 
245
     FIRST_STATIC_ARRAY:
246
 
247
     DECLARE
248
 
249
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
250
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
251
--            WITH A STATIC AGGREGATE.
252
 
253
          TYPE NUMBER IS RANGE 1 .. 100 ;
254
 
255
          GENERIC
256
 
257
            TYPE INTEGER_TYPE IS RANGE <> ;
258
            F_STATIC_VALUE : IN INTEGER_TYPE ;
259
            S_STATIC_VALUE : IN INTEGER_TYPE ;
260
            T_STATIC_VALUE : IN INTEGER_TYPE ;
261
            L_STATIC_VALUE : IN INTEGER_TYPE ;
262
            A_STATIC_VALUE : IN INTEGER_TYPE ;
263
            B_STATIC_VALUE : IN INTEGER_TYPE ;
264
            C_STATIC_VALUE : IN INTEGER_TYPE ;
265
            D_STATIC_VALUE : IN INTEGER_TYPE ;
266
 
267
          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
268
                         UPPER  : IN INTEGER_TYPE) ;
269
 
270
          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
271
                         UPPER  : IN INTEGER_TYPE) IS
272
 
273
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
274
                       RANGE LOWER .. UPPER ;
275
 
276
               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
277
                                       F_STATIC_VALUE .. S_STATIC_VALUE,
278
                                 INTEGER_TYPE RANGE
279
                                       T_STATIC_VALUE .. L_STATIC_VALUE)
280
                       OF SUBINTEGER_TYPE ;
281
 
282
               PROCEDURE P1D1 (A : A1 :=
283
                           ((A_STATIC_VALUE, B_STATIC_VALUE),
284
                           (C_STATIC_VALUE, D_STATIC_VALUE))) IS
285
               BEGIN  -- P1D1
286
                    REPORT.FAILED ("BODY OF P1D1 EXECUTED");
287
               EXCEPTION
288
                    WHEN OTHERS =>
289
                         REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
290
               END P1D1;
291
 
292
          BEGIN  -- P1D
293
               P1D1 ;
294
          EXCEPTION
295
               WHEN CONSTRAINT_ERROR =>
296
                    NULL;
297
               WHEN OTHERS =>
298
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
299
          END P1D;
300
 
301
          PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
302
                                        F_STATIC_VALUE => 21,
303
                                        S_STATIC_VALUE => 37,
304
                                        T_STATIC_VALUE => 67,
305
                                        L_STATIC_VALUE => 79,
306
                                        A_STATIC_VALUE => 11,
307
                                        B_STATIC_VALUE => 88,
308
                                        C_STATIC_VALUE => 87,
309
                                        D_STATIC_VALUE => 13) ;
310
 
311
     BEGIN  -- FIRST_STATIC_ARRAY
312
          NEW_P1D (LOWER => 10,
313
                     UPPER => 90);
314
     EXCEPTION
315
          WHEN OTHERS =>
316
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
317
     END FIRST_STATIC_ARRAY ;
318
 
319
     --------------------------------------------------
320
 
321
     SECOND_STATIC_ARRAY:
322
 
323
     DECLARE
324
 
325
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
326
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
327
--            WITH A STATIC AGGREGATE.
328
 
329
          TYPE NUMBER IS RANGE 1 .. 100 ;
330
 
331
          GENERIC
332
 
333
            TYPE INTEGER_TYPE IS RANGE <> ;
334
            F_STATIC_VALUE : IN INTEGER_TYPE ;
335
            S_STATIC_VALUE : IN INTEGER_TYPE ;
336
            T_STATIC_VALUE : IN INTEGER_TYPE ;
337
            L_STATIC_VALUE : IN INTEGER_TYPE ;
338
            A_STATIC_VALUE : IN INTEGER_TYPE ;
339
            B_STATIC_VALUE : IN INTEGER_TYPE ;
340
 
341
          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
342
                         UPPER  : IN INTEGER_TYPE) ;
343
 
344
          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
345
                         UPPER  : IN INTEGER_TYPE) IS
346
 
347
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
348
                       RANGE LOWER .. UPPER ;
349
 
350
               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
351
                                       F_STATIC_VALUE .. S_STATIC_VALUE,
352
                                 INTEGER_TYPE RANGE
353
                                       T_STATIC_VALUE .. L_STATIC_VALUE)
354
                       OF SUBINTEGER_TYPE ;
355
 
356
               PROCEDURE P2D1 (A : A1 :=
357
                                   (F_STATIC_VALUE .. S_STATIC_VALUE =>
358
                                   (A_STATIC_VALUE, B_STATIC_VALUE))) IS
359
               BEGIN  -- P2D1
360
                    REPORT.FAILED ("BODY OF P2D1 EXECUTED");
361
               EXCEPTION
362
                    WHEN OTHERS =>
363
                         REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
364
               END P2D1;
365
 
366
          BEGIN  -- P2D
367
               P2D1;
368
          EXCEPTION
369
               WHEN CONSTRAINT_ERROR =>
370
                    NULL;
371
               WHEN OTHERS =>
372
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
373
          END P2D;
374
 
375
          PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
376
                                        F_STATIC_VALUE => 21,
377
                                        S_STATIC_VALUE => 37,
378
                                        T_STATIC_VALUE => 67,
379
                                        L_STATIC_VALUE => 79,
380
                                        A_STATIC_VALUE => 7,
381
                                        B_STATIC_VALUE => 93) ;
382
 
383
     BEGIN  -- SECOND_STATIC_ARRAY
384
          NEW_P2D (LOWER => 5,
385
                   UPPER => 95);
386
     EXCEPTION
387
          WHEN OTHERS =>
388
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
389
     END SECOND_STATIC_ARRAY ;
390
 
391
     --------------------------------------------------
392
 
393
     REC_NON_STATIC_CONS:
394
 
395
     DECLARE
396
 
397
--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
398
--            INITIALIZED WITH A STATIC AGGREGATE.
399
 
400
          TYPE NUMBER IS RANGE 1 .. 100 ;
401
 
402
          GENERIC
403
 
404
            TYPE INTEGER_TYPE IS RANGE <> ;
405
            F_STATIC_VALUE : IN INTEGER_TYPE ;
406
            S_STATIC_VALUE : IN INTEGER_TYPE ;
407
            T_STATIC_VALUE : IN INTEGER_TYPE ;
408
            L_STATIC_VALUE : IN INTEGER_TYPE ;
409
            D_STATIC_VALUE : IN INTEGER_TYPE ;
410
 
411
          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
412
                        UPPER  : IN INTEGER_TYPE) ;
413
 
414
          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
415
                        UPPER  : IN INTEGER_TYPE) IS
416
 
417
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
418
                       RANGE LOWER .. UPPER ;
419
               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF
420
                     SUBINTEGER_TYPE ;
421
 
422
               TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
423
                    RECORD
424
                         FIRST  : SUBINTEGER_TYPE ;
425
                         SECOND : AR1 ;
426
                    END RECORD ;
427
 
428
               SUBTYPE REC4 IS REC (LOWER) ;
429
 
430
               PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
431
                                           F_STATIC_VALUE,
432
                                          (S_STATIC_VALUE,
433
                                           T_STATIC_VALUE,
434
                                           L_STATIC_VALUE))) IS
435
               BEGIN  -- PE1
436
                    REPORT.FAILED ("BODY OF PE1 EXECUTED");
437
               EXCEPTION
438
                    WHEN OTHERS =>
439
                         REPORT.FAILED ("EXCEPTION RAISED IN PE1");
440
               END PE1;
441
 
442
          BEGIN  -- PE
443
               PE1;
444
          EXCEPTION
445
               WHEN CONSTRAINT_ERROR =>
446
                    NULL;
447
               WHEN OTHERS =>
448
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
449
          END PE;
450
 
451
          PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
452
                                      F_STATIC_VALUE => 37,
453
                                      S_STATIC_VALUE => 21,
454
                                      T_STATIC_VALUE => 67,
455
                                      L_STATIC_VALUE => 79,
456
                                      D_STATIC_VALUE => 44) ;
457
 
458
     BEGIN  -- REC_NON_STATIC_CONS
459
          NEW_PE  (LOWER => 2,
460
                   UPPER => 99);
461
     EXCEPTION
462
          WHEN OTHERS =>
463
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
464
     END REC_NON_STATIC_CONS ;
465
 
466
     --------------------------------------------------
467
 
468
     REPORT.RESULT;
469
 
470
END CC3017B;

powered by: WebSVN 2.1.0

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