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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C61008A.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 NOT RAISED IF THE DEFAULT VALUE
26
-- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE 
27
-- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
28
-- THE DEFAULT IS USED.
29
 
30
--   SUBTESTS ARE:
31
--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
32
--            INITIALIZED WITH A STATIC AGGREGATE.
33
--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
34
--            INITIALIZED WITH A STATIC VALUE.
35
--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
36
--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
37
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
38
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
39
--            WITH A STATIC AGGREGATE.
40
--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
41
--            INITIALIZED WITH A STATIC AGGREGATE.
42
 
43
-- DAS  1/20/81
44
-- SPS 10/26/82
45
-- VKG 1/13/83
46
-- SPS 2/9/83
47
-- BHS 7/9/84
48
 
49
WITH REPORT;
50
PROCEDURE C61008A IS
51
 
52
     USE REPORT;
53
 
54
BEGIN
55
 
56
     TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
57
                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
58
                      "CONSTRAINTS ON A FORMAL PARAMETER");
59
 
60
     --------------------------------------------------
61
 
62
     DECLARE -- (A)
63
 
64
          PROCEDURE PA (I1, I2 : INTEGER) IS
65
 
66
               TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
67
 
68
               PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
69
               BEGIN
70
                    FAILED ("BODY OF PA1 EXECUTED");
71
               EXCEPTION
72
                    WHEN OTHERS =>
73
                         FAILED ("EXCEPTION RAISED IN PA1");
74
               END PA1;
75
 
76
          BEGIN
77
               PA1;
78
          EXCEPTION
79
               WHEN CONSTRAINT_ERROR =>
80
                    NULL;
81
               WHEN OTHERS =>
82
                    FAILED ("WRONG EXCEPTION RAISED - PA1");
83
          END PA;
84
 
85
     BEGIN   -- (A)
86
          PA (IDENT_INT(1), IDENT_INT(10));
87
     EXCEPTION
88
          WHEN OTHERS =>
89
               FAILED ("EXCEPTION RAISED IN CALL TO PA");
90
     END;    -- (A)
91
 
92
     --------------------------------------------------
93
 
94
     DECLARE -- (B)
95
 
96
          PROCEDURE PB (I1, I2 : INTEGER) IS
97
 
98
               SUBTYPE INT IS INTEGER RANGE I1..I2;
99
 
100
               PROCEDURE PB1 (I : INT := -1) IS
101
               BEGIN
102
                    FAILED ("BODY OF PB1 EXECUTED");
103
               EXCEPTION
104
                    WHEN OTHERS =>
105
                         FAILED ("EXCEPTION RAISED IN PB1");
106
               END PB1;
107
 
108
          BEGIN
109
               PB1;
110
          EXCEPTION
111
               WHEN CONSTRAINT_ERROR =>
112
                    NULL;
113
               WHEN OTHERS =>
114
                    FAILED ("WRONG EXCEPTION RAISED - PB1");
115
          END PB;
116
 
117
     BEGIN   -- (B)
118
          PB (IDENT_INT(0), IDENT_INT(63));
119
     EXCEPTION
120
          WHEN OTHERS =>
121
               FAILED ("EXCEPTION RAISED IN CALL TO PB");
122
     END;    -- (B)
123
 
124
     --------------------------------------------------
125
 
126
     DECLARE -- (C)
127
 
128
          PROCEDURE PC (I1, I2 : INTEGER) IS
129
               TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2;
130
               TYPE REC IS
131
                    RECORD
132
                         I : INTEGER RANGE I1..I2;
133
                         A : AR1 ;
134
                    END RECORD;
135
 
136
               PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
137
               BEGIN
138
                    FAILED ("BODY OF PC1 EXECUTED");
139
               EXCEPTION
140
                    WHEN OTHERS =>
141
                         FAILED ("EXCEPTION RAISED IN PC1");
142
               END PC1;
143
 
144
          BEGIN
145
               PC1;
146
          EXCEPTION
147
               WHEN CONSTRAINT_ERROR =>
148
                    NULL;
149
               WHEN OTHERS =>
150
                    FAILED ("WRONG EXCEPTION RAISED - PC1");
151
          END PC;
152
 
153
     BEGIN   -- (C)
154
          PC (IDENT_INT(1), IDENT_INT(3));
155
     EXCEPTION
156
          WHEN OTHERS =>
157
               FAILED ("EXCEPTION RAISED IN CALL TO PC");
158
     END;    -- (C)
159
 
160
     --------------------------------------------------
161
 
162
     DECLARE -- (D1)
163
 
164
          PROCEDURE P1D (I1, I2 : INTEGER) IS
165
 
166
               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
167
 
168
               PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
169
               BEGIN
170
                    FAILED ("BODY OF P1D1 EXECUTED");
171
               EXCEPTION
172
                    WHEN OTHERS =>
173
                         FAILED ("EXCEPTION RAISED IN P1D1");
174
               END P1D1;
175
 
176
          BEGIN
177
               P1D1;
178
          EXCEPTION
179
               WHEN CONSTRAINT_ERROR =>
180
                    NULL;
181
               WHEN OTHERS =>
182
                    FAILED ("WRONG EXCEPTION RAISED - P1D1");
183
          END P1D;
184
 
185
     BEGIN   -- (D1)
186
          P1D (IDENT_INT(1), IDENT_INT(2));
187
     EXCEPTION
188
          WHEN OTHERS =>
189
               FAILED ("EXCEPTION RAISED IN CALL TO P1D");
190
     END;    -- (D1)
191
 
192
     --------------------------------------------------
193
 
194
     DECLARE -- (D2)
195
 
196
          PROCEDURE P2D (I1, I2 : INTEGER) IS
197
 
198
               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
199
 
200
               PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
201
               BEGIN
202
                    FAILED ("BODY OF P2D1 EXECUTED");
203
               EXCEPTION
204
                    WHEN OTHERS =>
205
                         FAILED ("EXCEPTION RAISED IN P2D1");
206
               END P2D1;
207
 
208
          BEGIN
209
               P2D1;
210
          EXCEPTION
211
               WHEN CONSTRAINT_ERROR =>
212
                    NULL;
213
               WHEN OTHERS =>
214
                    FAILED ("WRONG EXCEPTION RAISED - P2D1");
215
          END P2D;
216
 
217
     BEGIN  -- (D2)
218
          P2D (IDENT_INT(1), IDENT_INT(2));
219
     EXCEPTION
220
          WHEN OTHERS =>
221
               FAILED ("EXCEPTION RAISED IN CALL TO P2D");
222
     END;   -- (D2)
223
 
224
     --------------------------------------------------
225
 
226
     DECLARE -- (E)
227
 
228
          PROCEDURE PE (I1, I2 : INTEGER) IS
229
               SUBTYPE INT IS INTEGER RANGE 0..10;
230
               TYPE ARR IS ARRAY (1..3) OF INT;
231
               TYPE REC (I : INT) IS
232
                    RECORD
233
                         A : ARR;
234
                    END RECORD;
235
 
236
               SUBTYPE REC4 IS REC(I1);
237
 
238
               PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
239
               BEGIN
240
                    FAILED ("BODY OF PE1 EXECUTED");
241
               EXCEPTION
242
                    WHEN OTHERS =>
243
                         FAILED ("EXCEPTION RAISED IN PE1");
244
               END PE1;
245
 
246
          BEGIN
247
               PE1;
248
          EXCEPTION
249
               WHEN CONSTRAINT_ERROR =>
250
                    NULL;
251
               WHEN OTHERS =>
252
                    FAILED ("WRONG EXCEPTION RAISED - PE1");
253
          END PE;
254
 
255
     BEGIN   -- (E)
256
          PE (IDENT_INT(4), IDENT_INT(10));
257
     EXCEPTION
258
          WHEN OTHERS =>
259
               FAILED ("EXCEPTION RAISED IN CALL TO PE");
260
     END;    -- (E)
261
 
262
     --------------------------------------------------
263
 
264
     RESULT;
265
 
266
END C61008A;

powered by: WebSVN 2.1.0

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