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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C37213J.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, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
27
--     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
28
--     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
29
--     OBJECT OR A SUBTYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
30
--     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
31
--          1) ONLY IN AN OBJECT DECLARATION, AND
32
--          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
33
--             IN THE SUBTYPE.
34
 
35
-- HISTORY:
36
--     JBG  10/17/86  CREATED ORIGINAL TEST.
37
--     VCL  10/23/87  MODIFIED THIS HEADER; SEPARATED THIS TEST INTO
38
--                    3 NEW TESTS (J,K,L); CHANGED THE AGGREGATE FOR
39
--                    THE PARAMETER 'VALUE' IN THE CALL OF PROCEDURE
40
--                    'SUBTYPE_CHK1';  MOVED THE CALL TO REPORT.TEST
41
--                    SO THAT IT COMES BEFORE ANY DECLARATIONS; ADDED
42
--                    A SEQUENCE COUNTER TO IDENTIFY WHICH SUBTEST
43
--                    DECLARATION PART RAISES CONSTRAINT_ERROR.
44
--     VCL  03/28/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
45
--                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
46
--                    PARAMETERS TO THE GENERIC UNITS AND THE
47
--                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
48
--                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
49
--                    ARE TOGETHER.
50
 
51
WITH REPORT; USE REPORT;
52
PROCEDURE C37213J IS
53
BEGIN
54
     TEST ("C37213J", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
55
                      "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
56
                      "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
57
                      "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
58
                      "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
59
                      "FORMAL TYPE USED TO DECLARE AN OBJECT OR A " &
60
                      "SUBTYPE");
61
 
62
     DECLARE
63
          SUBTYPE SM IS INTEGER RANGE 1..10;
64
          TYPE REC (D1, D2 : SM) IS
65
               RECORD NULL; END RECORD;
66
          TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
67
 
68
          SEQUENCE_NUMBER : INTEGER;
69
 
70
          GENERIC
71
               TYPE CONS IS PRIVATE;
72
               OBJ_XCP : BOOLEAN;
73
               TAG     : STRING;
74
          PACKAGE OBJ_CHK IS END OBJ_CHK;
75
 
76
          GENERIC
77
               TYPE CONS IS PRIVATE;
78
          PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
79
                                TAG     : STRING);
80
 
81
          PACKAGE BODY OBJ_CHK IS
82
          BEGIN          -- DECLARE AN OBJECT OF THE FORMAL TYPE.
83
               DECLARE
84
                    X : CONS;
85
 
86
                    FUNCTION VALUE RETURN CONS IS
87
                    BEGIN
88
                         IF EQUAL (3,3) THEN
89
                              RETURN X;
90
                         ELSE
91
                              RETURN X;
92
                         END IF;
93
                    END VALUE;
94
               BEGIN
95
                    IF OBJ_XCP THEN
96
                         FAILED ("NO CHECK DURING DECLARATION " &
97
                                 "OF OBJECT OF TYPE CONS - " & TAG);
98
                    ELSIF X /= VALUE THEN
99
                         FAILED ("INCORRECT VALUE FOR OBJECT OF " &
100
                                 "TYPE CONS - " & TAG);
101
                    END IF;
102
               END;
103
          EXCEPTION
104
               WHEN CONSTRAINT_ERROR =>
105
                    IF NOT OBJ_XCP THEN
106
                         FAILED ("IMPROPER CONSTRAINT CHECKED " &
107
                                 "DURING DECLARATION OF OBJECT " &
108
                                 "OF TYPE CONS - " & TAG);
109
                    END IF;
110
          END OBJ_CHK;
111
 
112
          PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
113
                                TAG     : STRING)    IS
114
          BEGIN          -- DECLARE A SUBTYPE OF THE FORMAL TYPE.
115
               DECLARE
116
                    SUBTYPE SCONS IS CONS;
117
               BEGIN
118
                    DECLARE
119
                         X : SCONS;
120
 
121
                         FUNCTION VALUE RETURN SCONS IS
122
                         BEGIN
123
                              IF EQUAL (5, 5) THEN
124
                                   RETURN X;
125
                              ELSE
126
                                   RETURN X;
127
                              END IF;
128
                         END VALUE;
129
                    BEGIN
130
                         IF OBJ_XCP THEN
131
                              FAILED ("NO CHECK DURING DECLARATION " &
132
                                      "OF OBJECT OF SUBTYPE SCONS - " &
133
                                      TAG);
134
                         ELSIF X /= VALUE THEN
135
                              FAILED ("INCORRECT VALUE FOR OBJECT " &
136
                                      "OF SUBTYPE SCONS - " & TAG);
137
                         END IF;
138
                    END;
139
               EXCEPTION
140
                    WHEN CONSTRAINT_ERROR =>
141
                         IF NOT OBJ_XCP THEN
142
                              FAILED ("IMPROPER CONSTRAINT CHECKED " &
143
                                      "DURING DECLARATION OF OBJECT " &
144
                                      "OF SUBTYPE SCONS - " & TAG);
145
                         END IF;
146
               END;
147
          EXCEPTION
148
               WHEN CONSTRAINT_ERROR =>
149
                    FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
150
                            "DURING SUBTYPE DECLARATION - " & TAG);
151
          END SUBTYP_CHK;
152
     BEGIN
153
          SEQUENCE_NUMBER := 1;
154
          DECLARE
155
               TYPE REC_DEF (D3 : INTEGER := 1) IS
156
                    RECORD
157
                         C1 : REC (D3, 0);
158
                    END RECORD;
159
 
160
               PACKAGE PACK1 IS NEW OBJ_CHK (REC_DEF,
161
                         OBJ_XCP => TRUE,
162
                         TAG     => "PACK1");
163
 
164
               PROCEDURE PROC1 IS NEW SUBTYP_CHK (REC_DEF);
165
          BEGIN
166
               PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
167
          END;
168
 
169
          SEQUENCE_NUMBER := 2;
170
          DECLARE
171
               TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
172
                    RECORD
173
                         C1 : MY_ARR (0..D3);
174
                    END RECORD;
175
 
176
               PACKAGE PACK2 IS NEW OBJ_CHK (ARR_DEF,
177
                         OBJ_XCP => TRUE,
178
                         TAG     => "PACK2");
179
 
180
               PROCEDURE PROC2 IS NEW SUBTYP_CHK (ARR_DEF);
181
          BEGIN
182
               PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
183
          END;
184
 
185
 
186
          SEQUENCE_NUMBER := 3;
187
          DECLARE
188
               TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
189
                    RECORD
190
                         CASE D3 IS
191
                              WHEN -5..10 =>
192
                                   C1 : REC (D3, IDENT_INT(11));
193
                              WHEN OTHERS =>
194
                                   C2 : INTEGER := IDENT_INT(5);
195
                         END CASE;
196
                    END RECORD;
197
 
198
               PACKAGE PACK3 IS NEW OBJ_CHK (VAR_REC_DEF1,
199
                              OBJ_XCP => TRUE,
200
                              TAG     => "PACK3");
201
 
202
               PROCEDURE PROC3 IS NEW SUBTYP_CHK (VAR_REC_DEF1);
203
          BEGIN
204
               PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
205
          END;
206
 
207
          SEQUENCE_NUMBER := 4;
208
          DECLARE
209
               TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
210
                    RECORD
211
                         CASE D3 IS
212
                              WHEN -5..10 =>
213
                                   C1 : REC (D3, IDENT_INT(11));
214
                              WHEN OTHERS =>
215
                                   C2 : INTEGER := IDENT_INT(5);
216
                         END CASE;
217
                    END RECORD;
218
 
219
               PACKAGE PACK4 IS NEW OBJ_CHK (VAR_REC_DEF6,
220
                              OBJ_XCP => FALSE,
221
                              TAG     => "PACK4");
222
 
223
               PROCEDURE PROC4 IS NEW SUBTYP_CHK (VAR_REC_DEF6);
224
          BEGIN
225
               PROC4 (OBJ_XCP => FALSE,TAG => "PROC4");
226
          END;
227
 
228
          SEQUENCE_NUMBER := 5;
229
          DECLARE
230
               TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
231
                    RECORD
232
                         CASE D3 IS
233
                              WHEN -5..10 =>
234
                                   C1 : REC (D3, IDENT_INT(11));
235
                              WHEN OTHERS =>
236
                                   C2 : INTEGER := IDENT_INT(5);
237
                         END CASE;
238
                    END RECORD;
239
 
240
               PACKAGE PACK5 IS NEW OBJ_CHK (VAR_REC_DEF11,
241
                              OBJ_XCP => FALSE,
242
                              TAG     => "PACK5");
243
 
244
               PROCEDURE PROC5 IS NEW SUBTYP_CHK (VAR_REC_DEF11);
245
          BEGIN
246
               PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
247
          END;
248
 
249
          SEQUENCE_NUMBER := 6;
250
          DECLARE
251
               TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
252
                    RECORD
253
                         CASE D3 IS
254
                              WHEN -5..10 =>
255
                                   C1 : MY_ARR(D3..IDENT_INT(11));
256
                              WHEN OTHERS =>
257
                                   C2 : INTEGER := IDENT_INT(5);
258
                         END CASE;
259
                    END RECORD;
260
 
261
               PACKAGE PACK6 IS NEW OBJ_CHK (VAR_ARR_DEF1,
262
                              OBJ_XCP => TRUE,
263
                              TAG     => "PACK6");
264
 
265
               PROCEDURE PROC6 IS NEW SUBTYP_CHK (VAR_ARR_DEF1);
266
          BEGIN
267
               PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
268
          END;
269
 
270
          SEQUENCE_NUMBER := 7;
271
          DECLARE
272
               TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
273
                    RECORD
274
                         CASE D3 IS
275
                              WHEN -5..10 =>
276
                                   C1 : MY_ARR(D3..IDENT_INT(11));
277
                              WHEN OTHERS =>
278
                                   C2 : INTEGER := IDENT_INT(5);
279
                         END CASE;
280
                    END RECORD;
281
 
282
               PACKAGE PACK7 IS NEW OBJ_CHK (VAR_ARR_DEF6,
283
                              OBJ_XCP => FALSE,
284
                              TAG     => "PACK7");
285
 
286
               PROCEDURE PROC7 IS NEW SUBTYP_CHK (VAR_ARR_DEF6);
287
          BEGIN
288
               PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
289
          END;
290
 
291
          SEQUENCE_NUMBER := 8;
292
          DECLARE
293
               TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
294
                    RECORD
295
                         CASE D3 IS
296
                              WHEN -5..10 =>
297
                                   C1 : MY_ARR(D3..IDENT_INT(11));
298
                              WHEN OTHERS =>
299
                                   C2 : INTEGER := IDENT_INT(5);
300
                         END CASE;
301
                    END RECORD;
302
 
303
               PACKAGE PACK8 IS NEW OBJ_CHK (VAR_ARR_DEF11,
304
                              OBJ_XCP => FALSE,
305
                              TAG     => "PACK8");
306
 
307
               PROCEDURE PROC8 IS NEW SUBTYP_CHK (VAR_ARR_DEF11);
308
          BEGIN
309
               PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
310
          END;
311
 
312
     EXCEPTION
313
          WHEN OTHERS =>
314
               FAILED ("EXCEPTION RAISED DURING DECLARATION / " &
315
                       "INSTANTIATION ELABORATION - " &
316
                       INTEGER'IMAGE(SEQUENCE_NUMBER));
317
     END;
318
 
319
     RESULT;
320
END C37213J;

powered by: WebSVN 2.1.0

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