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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC1311A.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 THE DEFAULT EXPRESSIONS OF THE PARAMETERS OF A FORMAL
26
--     SUBPROGRAM ARE USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE
27
--     ACTUAL SUBPROGRAM PARAMETER.
28
 
29
-- HISTORY:
30
--     RJW 06/05/86  CREATED ORIGINAL TEST.
31
--     VCL 08/18/87  CHANGED A COUPLE OF STATIC DEFAULT EXPRESSIONS FOR
32
--                   FORMAL SUBPROGRAM PARAMETERS TO DYNAMIC 
33
--                   EXPRESSIONS VIA THE USE OF THE IDENTITY FUNCTION.
34
--     EDWARD V. BERARD 08/13/90  
35
--                   ADDED CHECKS FOR MULTI-DIMENSIONAL ARRAYS.
36
 
37
WITH REPORT ;
38
 
39
PROCEDURE CC1311A IS
40
 
41
     TYPE NUMBERS IS (ZERO, ONE ,TWO);
42
 
43
     SHORT_START : CONSTANT := -100 ;
44
     SHORT_END   : CONSTANT := 100 ;
45
     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
46
 
47
     SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
48
 
49
     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
50
                         SEP, OCT, NOV, DEC) ;
51
 
52
     SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
53
 
54
     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
55
     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
56
     TYPE DATE IS RECORD
57
          MONTH : MONTH_TYPE ;
58
          DAY   : DAY_TYPE ;
59
          YEAR  : YEAR_TYPE ;
60
     END RECORD ;
61
 
62
     TODAY         : DATE := (MONTH => AUG,
63
                              DAY   => 8,
64
                              YEAR  => 1990) ;
65
 
66
     FIRST_DATE     : DATE := (DAY   => 6,
67
                               MONTH => JUN,
68
                               YEAR  => 1967) ;
69
 
70
     SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
71
 
72
     TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
73
                                      FIRST_HALF,
74
                                      FIRST_FIVE) OF DATE ;
75
 
76
     GENERIC
77
 
78
          TYPE FIRST_INDEX IS (<>) ;
79
          TYPE SECOND_INDEX IS (<>) ;
80
          TYPE THIRD_INDEX IS (<>) ;
81
          TYPE COMPONENT_TYPE IS PRIVATE ;
82
          DEFAULT_VALUE : IN COMPONENT_TYPE ;
83
          TYPE CUBE IS ARRAY (FIRST_INDEX,
84
                              SECOND_INDEX,
85
                              THIRD_INDEX) OF COMPONENT_TYPE ;
86
          WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
87
                                                (CUBE'RANGE (2) =>
88
                                                (CUBE'RANGE (3) =>
89
                                                     DEFAULT_VALUE))))
90
                        RETURN CUBE ;
91
 
92
     PROCEDURE PROC_WITH_3D_FUNC ;
93
 
94
     PROCEDURE PROC_WITH_3D_FUNC IS
95
 
96
     BEGIN  -- PROC_WITH_3D_FUNC
97
 
98
          IF FUN /= CUBE'(CUBE'RANGE =>
99
                         (CUBE'RANGE (2) =>
100
                         (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
101
               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
102
                              "ARRAY, FUNCTION, AND PROCEDURE.") ;
103
          END IF ;
104
 
105
     END PROC_WITH_3D_FUNC ;
106
 
107
     GENERIC
108
 
109
          TYPE FIRST_INDEX IS (<>) ;
110
          TYPE SECOND_INDEX IS (<>) ;
111
          TYPE THIRD_INDEX IS (<>) ;
112
          TYPE COMPONENT_TYPE IS PRIVATE ;
113
          DEFAULT_VALUE : IN COMPONENT_TYPE ;
114
          TYPE CUBE IS ARRAY (FIRST_INDEX,
115
                              SECOND_INDEX,
116
                              THIRD_INDEX) OF COMPONENT_TYPE ;
117
          WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
118
                                                (CUBE'RANGE (2) =>
119
                                                (CUBE'RANGE (3) =>
120
                                                     DEFAULT_VALUE))))
121
                        RETURN CUBE ;
122
 
123
     PACKAGE PKG_WITH_3D_FUNC IS
124
     END PKG_WITH_3D_FUNC ;
125
 
126
     PACKAGE BODY PKG_WITH_3D_FUNC IS
127
     BEGIN  -- PKG_WITH_3D_FUNC
128
 
129
          REPORT.TEST("CC1311A","CHECK THAT THE DEFAULT EXPRESSIONS " &
130
                      "OF THE PARAMETERS OF A FORMAL SUBPROGRAM ARE " &
131
                      "USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE " &
132
                      "ACTUAL SUBPROGRAM PARAMETER" ) ;
133
 
134
          IF FUN /= CUBE'(CUBE'RANGE =>
135
                         (CUBE'RANGE (2) =>
136
                         (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
137
               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
138
                              "ARRAY, FUNCTION, AND PACKAGE.") ;
139
          END IF ;
140
 
141
     END PKG_WITH_3D_FUNC ;
142
 
143
     GENERIC
144
 
145
          TYPE FIRST_INDEX IS (<>) ;
146
          TYPE SECOND_INDEX IS (<>) ;
147
          TYPE THIRD_INDEX IS (<>) ;
148
          TYPE COMPONENT_TYPE IS PRIVATE ;
149
          DEFAULT_VALUE : IN COMPONENT_TYPE ;
150
          TYPE CUBE IS ARRAY (FIRST_INDEX,
151
                              SECOND_INDEX,
152
                              THIRD_INDEX) OF COMPONENT_TYPE ;
153
          WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
154
                                                (CUBE'RANGE (2) =>
155
                                                (CUBE'RANGE (3) =>
156
                                                     DEFAULT_VALUE))))
157
                        RETURN CUBE ;
158
 
159
     FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN ;
160
 
161
     FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN IS
162
     BEGIN  -- FUNC_WITH_3D_FUNC
163
 
164
          RETURN FUN = CUBE'(CUBE'RANGE =>
165
                            (CUBE'RANGE (2) =>
166
                            (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
167
 
168
     END FUNC_WITH_3D_FUNC ;
169
 
170
     GENERIC
171
 
172
          TYPE FIRST_INDEX IS (<>) ;
173
          TYPE SECOND_INDEX IS (<>) ;
174
          TYPE THIRD_INDEX IS (<>) ;
175
          TYPE COMPONENT_TYPE IS PRIVATE ;
176
          DEFAULT_VALUE : IN COMPONENT_TYPE ;
177
          TYPE CUBE IS ARRAY (FIRST_INDEX,
178
                              SECOND_INDEX,
179
                              THIRD_INDEX) OF COMPONENT_TYPE ;
180
          WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
181
                                                    (CUBE'RANGE (2) =>
182
                                                    (CUBE'RANGE (3) =>
183
                                                     DEFAULT_VALUE))) ;
184
                               OUTPUT : OUT CUBE) ;
185
 
186
     PROCEDURE PROC_WITH_3D_PROC ;
187
 
188
     PROCEDURE PROC_WITH_3D_PROC IS
189
 
190
          RESULTS : CUBE ;
191
 
192
     BEGIN  -- PROC_WITH_3D_PROC
193
 
194
          PROC (OUTPUT => RESULTS) ;
195
 
196
          IF RESULTS /= CUBE'(CUBE'RANGE =>
197
                             (CUBE'RANGE (2) =>
198
                             (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
199
               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
200
                              "ARRAY, PROCEDURE, AND PROCEDURE.") ;
201
          END IF ;
202
 
203
     END PROC_WITH_3D_PROC ;
204
 
205
     GENERIC
206
 
207
          TYPE FIRST_INDEX IS (<>) ;
208
          TYPE SECOND_INDEX IS (<>) ;
209
          TYPE THIRD_INDEX IS (<>) ;
210
          TYPE COMPONENT_TYPE IS PRIVATE ;
211
          DEFAULT_VALUE : IN COMPONENT_TYPE ;
212
          TYPE CUBE IS ARRAY (FIRST_INDEX,
213
                              SECOND_INDEX,
214
                              THIRD_INDEX) OF COMPONENT_TYPE ;
215
          WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
216
                                                    (CUBE'RANGE (2) =>
217
                                                    (CUBE'RANGE (3) =>
218
                                                     DEFAULT_VALUE))) ;
219
                               OUTPUT : OUT CUBE) ;
220
 
221
     PACKAGE PKG_WITH_3D_PROC IS
222
     END PKG_WITH_3D_PROC ;
223
 
224
     PACKAGE BODY PKG_WITH_3D_PROC IS
225
 
226
          RESULTS : CUBE ;
227
 
228
     BEGIN  -- PKG_WITH_3D_PROC
229
 
230
          PROC (OUTPUT => RESULTS) ;
231
 
232
          IF RESULTS /= CUBE'(CUBE'RANGE =>
233
                             (CUBE'RANGE (2) =>
234
                             (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
235
               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
236
                              "ARRAY, PROCEDURE, AND PACKAGE.") ;
237
          END IF ;
238
 
239
     END PKG_WITH_3D_PROC ;
240
 
241
     GENERIC
242
 
243
          TYPE FIRST_INDEX IS (<>) ;
244
          TYPE SECOND_INDEX IS (<>) ;
245
          TYPE THIRD_INDEX IS (<>) ;
246
          TYPE COMPONENT_TYPE IS PRIVATE ;
247
          DEFAULT_VALUE : IN COMPONENT_TYPE ;
248
          TYPE CUBE IS ARRAY (FIRST_INDEX,
249
                              SECOND_INDEX,
250
                              THIRD_INDEX) OF COMPONENT_TYPE ;
251
          WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
252
                                                    (CUBE'RANGE (2) =>
253
                                                    (CUBE'RANGE (3) =>
254
                                                     DEFAULT_VALUE))) ;
255
                               OUTPUT : OUT CUBE) ;
256
 
257
     FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN ;
258
 
259
     FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN IS
260
 
261
          RESULTS : CUBE ;
262
 
263
     BEGIN  -- FUNC_WITH_3D_PROC
264
 
265
          PROC (OUTPUT => RESULTS) ;
266
          RETURN RESULTS = CUBE'(CUBE'RANGE =>
267
                                (CUBE'RANGE (2) =>
268
                                (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
269
 
270
     END FUNC_WITH_3D_PROC ;
271
 
272
     GENERIC
273
          TYPE T IS (<>);
274
          WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
275
     FUNCTION FUNC1 RETURN BOOLEAN;
276
 
277
     FUNCTION FUNC1 RETURN BOOLEAN IS
278
     BEGIN  -- FUNC1
279
         RETURN F = T'VAL (0);
280
     END FUNC1;
281
 
282
     GENERIC
283
          TYPE T IS (<>);
284
          WITH FUNCTION F (X : T := T'VAL (REPORT.IDENT_INT(0)))
285
                        RETURN T;
286
     PACKAGE PKG1 IS END PKG1;
287
 
288
     PACKAGE BODY PKG1 IS
289
     BEGIN  -- PKG1
290
          IF F /= T'VAL (0) THEN
291
               REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
292
                              "FUNCTION 'F' AND PACKAGE 'PKG1'" );
293
          END IF;
294
     END PKG1;
295
     GENERIC
296
          TYPE T IS (<>);
297
          WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
298
     PROCEDURE PROC1;
299
 
300
     PROCEDURE PROC1 IS
301
     BEGIN  -- PROC1
302
          IF F /= T'VAL (0) THEN
303
               REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
304
                              "FUNCTION 'F' AND PROCEDURE 'PROC1'" );
305
          END IF;
306
     END PROC1;
307
 
308
     GENERIC
309
          TYPE T IS (<>);
310
          WITH PROCEDURE P (RESULTS : OUT T ;
311
                            X       : T := T'VAL (0)) ;
312
     FUNCTION FUNC2 RETURN BOOLEAN;
313
 
314
     FUNCTION FUNC2 RETURN BOOLEAN IS
315
          RESULTS : T;
316
     BEGIN  -- FUNC2
317
          P (RESULTS);
318
          RETURN RESULTS = T'VAL (0);
319
     END FUNC2;
320
 
321
     GENERIC
322
          TYPE T IS (<>);
323
          WITH PROCEDURE P (RESULTS : OUT T;
324
                            X       : T := T'VAL(REPORT.IDENT_INT(0)));
325
     PACKAGE PKG2 IS END PKG2 ;
326
 
327
     PACKAGE BODY PKG2 IS
328
          RESULTS : T;
329
     BEGIN  -- PKG2
330
          P (RESULTS);
331
          IF RESULTS /= T'VAL (0) THEN
332
                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
333
                               "PROCEDURE 'P' AND PACKAGE 'PKG2'" );
334
          END IF;
335
     END PKG2;
336
 
337
     GENERIC
338
          TYPE T IS (<>);
339
          WITH PROCEDURE P (RESULTS :OUT T; X : T := T'VAL (0));
340
     PROCEDURE PROC2;
341
 
342
     PROCEDURE PROC2 IS
343
          RESULTS : T;
344
     BEGIN  -- PROC2
345
          P (RESULTS);
346
          IF RESULTS /= T'VAL (0) THEN
347
               REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
348
                             "PROCEDURE 'P' AND PROCEDURE 'PROC2'" );
349
          END IF;
350
     END PROC2;
351
 
352
     FUNCTION F1 (A : NUMBERS := ONE) RETURN NUMBERS IS
353
     BEGIN  -- F1
354
          RETURN A;
355
     END;
356
 
357
     PROCEDURE P2 (OUTVAR : OUT NUMBERS; INVAR : NUMBERS := TWO) IS
358
     BEGIN  -- P2
359
          OUTVAR := INVAR;
360
     END;
361
 
362
     FUNCTION TD_FUNC (FIRST : IN THREE_DIMENSIONAL :=
363
                                       (THREE_DIMENSIONAL'RANGE =>
364
                                       (THREE_DIMENSIONAL'RANGE (2) =>
365
                                       (THREE_DIMENSIONAL'RANGE (3) =>
366
                                            FIRST_DATE))))
367
              RETURN THREE_DIMENSIONAL IS
368
 
369
     BEGIN  -- TD_FUNC
370
 
371
          RETURN FIRST ;
372
 
373
     END TD_FUNC ;
374
 
375
     PROCEDURE TD_PROC (INPUT  : IN  THREE_DIMENSIONAL :=
376
                                        (THREE_DIMENSIONAL'RANGE =>
377
                                        (THREE_DIMENSIONAL'RANGE (2) =>
378
                                        (THREE_DIMENSIONAL'RANGE (3) =>
379
                                             FIRST_DATE))) ;
380
                        OUTPUT : OUT THREE_DIMENSIONAL) IS
381
     BEGIN  -- TD_PROC
382
 
383
          OUTPUT := INPUT ;
384
 
385
     END TD_PROC ;
386
 
387
     PROCEDURE NEW_PROC_WITH_3D_FUNC IS NEW
388
          PROC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
389
                             SECOND_INDEX   => FIRST_HALF,
390
                             THIRD_INDEX    => FIRST_FIVE,
391
                             COMPONENT_TYPE => DATE,
392
                             DEFAULT_VALUE  => TODAY,
393
                             CUBE           => THREE_DIMENSIONAL,
394
                             FUN            => TD_FUNC) ;
395
 
396
     PACKAGE NEW_PKG_WITH_3D_FUNC IS NEW
397
          PKG_WITH_3D_FUNC (FIRST_INDEX     => REALLY_SHORT,
398
                            SECOND_INDEX    => FIRST_HALF,
399
                            THIRD_INDEX     => FIRST_FIVE,
400
                            COMPONENT_TYPE  => DATE,
401
                            DEFAULT_VALUE   => TODAY,
402
                            CUBE            => THREE_DIMENSIONAL,
403
                            FUN             => TD_FUNC) ;
404
 
405
      FUNCTION NEW_FUNC_WITH_3D_FUNC IS NEW
406
          FUNC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
407
                             SECOND_INDEX   => FIRST_HALF,
408
                             THIRD_INDEX    => FIRST_FIVE,
409
                             COMPONENT_TYPE => DATE,
410
                             DEFAULT_VALUE  => TODAY,
411
                             CUBE           => THREE_DIMENSIONAL,
412
                             FUN            => TD_FUNC) ;
413
 
414
     PROCEDURE NEW_PROC_WITH_3D_PROC IS NEW
415
          PROC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
416
                             SECOND_INDEX   => FIRST_HALF,
417
                             THIRD_INDEX    => FIRST_FIVE,
418
                             COMPONENT_TYPE => DATE,
419
                             DEFAULT_VALUE  => TODAY,
420
                             CUBE           => THREE_DIMENSIONAL,
421
                             PROC           => TD_PROC) ;
422
 
423
     PACKAGE NEW_PKG_WITH_3D_PROC IS NEW
424
          PKG_WITH_3D_PROC (FIRST_INDEX     => REALLY_SHORT,
425
                            SECOND_INDEX   => FIRST_HALF,
426
                            THIRD_INDEX    => FIRST_FIVE,
427
                            COMPONENT_TYPE => DATE,
428
                            DEFAULT_VALUE  => TODAY,
429
                            CUBE           => THREE_DIMENSIONAL,
430
                            PROC           => TD_PROC) ;
431
 
432
     FUNCTION NEW_FUNC_WITH_3D_PROC IS NEW
433
          FUNC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
434
                             SECOND_INDEX   => FIRST_HALF,
435
                             THIRD_INDEX    => FIRST_FIVE,
436
                             COMPONENT_TYPE => DATE,
437
                             DEFAULT_VALUE  => TODAY,
438
                             CUBE           => THREE_DIMENSIONAL,
439
                             PROC           => TD_PROC) ;
440
 
441
     FUNCTION  NFUNC1 IS NEW FUNC1 (NUMBERS, F1);
442
     PACKAGE   NPKG1  IS NEW PKG1  (NUMBERS, F1);
443
     PROCEDURE NPROC1 IS NEW PROC1 (NUMBERS, F1);
444
 
445
     FUNCTION  NFUNC2 IS NEW FUNC2 (NUMBERS, P2);
446
     PACKAGE   NPKG2  IS NEW PKG2  (NUMBERS, P2);
447
     PROCEDURE NPROC2 IS NEW PROC2 (NUMBERS, P2);
448
 
449
BEGIN  -- CC1311A
450
 
451
     IF NOT NFUNC1 THEN
452
          REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
453
                         "WITH FUNCTION 'NFUNC1'" ) ;
454
     END IF ;
455
 
456
     IF NOT NFUNC2 THEN
457
          REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
458
                         "WITH FUNCTION 'NFUNC2'" ) ;
459
     END IF ;
460
 
461
     NPROC1 ;
462
     NPROC2 ;
463
 
464
     NEW_PROC_WITH_3D_FUNC ;
465
 
466
     IF NOT NEW_FUNC_WITH_3D_FUNC THEN
467
          REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
468
                         "FUNCTION, AND FUNCTION.") ;
469
     END IF ;
470
 
471
     NEW_PROC_WITH_3D_PROC ;
472
 
473
     IF NOT NEW_FUNC_WITH_3D_PROC THEN
474
          REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
475
                         "FUNCTION, AND PROCEDURE.") ;
476
     END IF ;
477
 
478
     REPORT.RESULT ;
479
 
480
END CC1311A ;

powered by: WebSVN 2.1.0

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