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

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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