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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C83051A.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 THAT DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED
27
--     WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION
28
--     FROM OUTSIDE THE OUTERMOST PACKAGE.
29
 
30
-- HISTORY:
31
--     GMT 09/07/88  CREATED ORIGINAL TEST.
32
 
33
WITH REPORT; USE REPORT;
34
 
35
PROCEDURE C83051A IS
36
 
37
BEGIN
38
     TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " &
39
                      "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " &
40
                      "PART OF A PACKAGE ARE VISIBLE BY SELECTION " &
41
                      "FROM OUTSIDE THE OUTERMOST PACKAGE");
42
     A_BLOCK:
43
     DECLARE
44
          PACKAGE APACK IS
45
               PACKAGE BPACK  IS
46
                    TYPE    T1  IS (RED,GREEN);
47
                    TYPE    T2A IS ('A', 'B', 'C', 'D');
48
                    TYPE    T3  IS NEW BOOLEAN;
49
                    TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
50
                    TYPE    T5  IS DIGITS 5;
51
                    TYPE    T67 IS DELTA 0.5 RANGE -2.0 .. 10.0;
52
                    TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
53
                    SUBTYPE T9B IS T9A (1..10);
54
                    TYPE    T9C IS ACCESS T9B;
55
                    TYPE    T10 IS PRIVATE;
56
                    V1       : T3 := FALSE;
57
                    ZERO     : CONSTANT T4 := 0;
58
                    A_FLT    : T5 := 3.0;
59
                    A_FIX    : T67 := -1.0;
60
                    ARY      : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE);
61
                    P1 : T9C := NEW T9B'( 1..5  => T3'(TRUE),
62
                                          6..10 => T3'(FALSE) );
63
                    C1 : CONSTANT T10;
64
 
65
                    FUNCTION RET_T1 (X : T1) RETURN T1;
66
 
67
                    FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
68
 
69
                    GENERIC
70
                    PROCEDURE DO_NOTHING (X : IN OUT T3);
71
               PRIVATE
72
                    TYPE T10 IS NEW CHARACTER;
73
                    C1 : CONSTANT T10 := 'J';
74
               END BPACK;
75
          END APACK;
76
 
77
     PACKAGE BODY APACK IS
78
          PACKAGE BODY BPACK IS
79
               FUNCTION RET_T1 (X : T1) RETURN T1 IS
80
               BEGIN
81
                    IF X = RED THEN
82
                         RETURN GREEN;
83
                    ELSE
84
                         RETURN RED;
85
                    END IF;
86
               END RET_T1;
87
 
88
               FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
89
               BEGIN
90
                    RETURN T10(X);
91
               END RET_CHAR;
92
 
93
               PROCEDURE DO_NOTHING (X : IN OUT T3) IS
94
               BEGIN
95
                    IF X = TRUE THEN
96
                         X := FALSE;
97
                    ELSE
98
                         X := TRUE;
99
                    END IF;
100
               END DO_NOTHING;
101
          END BPACK;
102
     END APACK;
103
 
104
     PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
105
 
106
     BEGIN
107
 
108
          -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
109
 
110
          IF  APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
111
               FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
112
                       "LITERAL BAD - A1");
113
          END IF;
114
 
115
 
116
          -- A2: VISIBILITY FOR OVERLOADED
117
          --     ENUMERATION CHARACTER LITERALS
118
 
119
          IF  APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'),
120
                              APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN
121
               FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
122
                       "LITERAL BAD - A2");
123
          END IF;
124
 
125
 
126
          -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
127
 
128
          IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE),
129
                             APACK.BPACK.FALSE) THEN
130
               FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
131
          END IF;
132
 
133
 
134
          -- A4: VISIBILITY FOR AN INTEGER TYPE
135
 
136
          IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO)
137
               THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4");
138
          END IF;
139
 
140
 
141
          -- A5: VISIBILITY FOR A FLOATING POINT TYPE
142
 
143
          IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT)
144
               THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
145
          END IF;
146
 
147
 
148
          -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
149
 
150
          IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67'
151
                            (APACK.BPACK."-"(1.5))) THEN
152
               FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " &
153
                       "BAD - A6");
154
          END IF;
155
 
156
 
157
          -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
158
 
159
          IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/"
160
                             (APACK.BPACK.A_FIX,2)) THEN
161
               FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " &
162
                       "INTEGER BAD - A7");
163
          END IF;
164
 
165
 
166
          -- A8: VISIBILITY FOR ARRAY EQUALITY
167
 
168
          IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE),
169
             APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE),
170
             APACK.BPACK.T3(FALSE))) THEN
171
               FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8");
172
          END IF;
173
 
174
 
175
          -- A9: VISIBILITY FOR ACCESS EQUALITY
176
 
177
          IF APACK.BPACK."/="(APACK.BPACK.P1(3),
178
                              APACK.BPACK.T3(IDENT_BOOL(TRUE)))
179
               THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
180
          END IF;
181
 
182
 
183
          -- A10: VISIBILITY FOR PRIVATE TYPE
184
 
185
          IF APACK.BPACK."/="(APACK.BPACK.C1,
186
                              APACK.BPACK.RET_CHAR('J')) THEN
187
               FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10");
188
          END IF;
189
 
190
 
191
          -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
192
 
193
          IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED),
194
                              APACK.BPACK.GREEN) THEN
195
               FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
196
          END IF;
197
 
198
          -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
199
 
200
          NEW_DO_NOTHING (APACK.BPACK.V1);
201
 
202
          IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN
203
               FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
204
          END IF;
205
 
206
     END A_BLOCK;
207
 
208
     B_BLOCK:
209
     DECLARE
210
          GENERIC
211
               TYPE T1 IS (<>);
212
          PACKAGE GENPACK IS
213
               PACKAGE APACK IS
214
                    PACKAGE BPACK  IS
215
                         TYPE    T1  IS (ORANGE,GREEN);
216
                         TYPE    T2A IS ('E', 'F', 'G');
217
                         TYPE    T3  IS NEW BOOLEAN;
218
                         TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
219
                         TYPE    T5  IS DIGITS 5;
220
                         TYPE    T67 IS DELTA 0.5 RANGE -3.0 .. 25.0;
221
                         TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
222
                         SUBTYPE T9B IS T9A (2 .. 8);
223
                         TYPE    T9C IS ACCESS T9B;
224
                         TYPE    T10 IS PRIVATE;
225
                         V1    : T3 := TRUE;
226
                         SIX   : T4 := 6;
227
                         B_FLT : T5 := 4.0;
228
                         ARY   : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE);
229
                         P1    : T9C := NEW T9B'( 2..4 => T3'(FALSE),
230
                                                  5..8 => T3'(TRUE));
231
                         K1 : CONSTANT T10;
232
 
233
                         FUNCTION RET_T1 (X : T1) RETURN T1;
234
 
235
                         FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
236
 
237
                         GENERIC
238
                         PROCEDURE DO_NOTHING (X : IN OUT T3);
239
                    PRIVATE
240
                         TYPE T10 IS NEW CHARACTER;
241
                         K1 : CONSTANT T10 := 'V';
242
                    END BPACK;
243
               END APACK;
244
          END GENPACK;
245
 
246
          PACKAGE BODY GENPACK IS
247
               PACKAGE BODY APACK IS
248
                    PACKAGE BODY BPACK IS
249
                         FUNCTION RET_T1 (X : T1) RETURN T1 IS
250
                         BEGIN
251
                              IF X = ORANGE THEN
252
                                   RETURN GREEN;
253
                              ELSE
254
                                   RETURN ORANGE;
255
                              END IF;
256
                         END RET_T1;
257
 
258
                         FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
259
                         BEGIN
260
                              RETURN T10(X);
261
                         END RET_CHAR;
262
 
263
                         PROCEDURE DO_NOTHING (X : IN OUT T3) IS
264
                         BEGIN
265
                              IF X = TRUE THEN
266
                                   X := FALSE;
267
                              ELSE
268
                                   X := TRUE;
269
                              END IF;
270
                         END DO_NOTHING;
271
                    END BPACK;
272
               END APACK;
273
          END GENPACK;
274
 
275
          PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
276
 
277
          PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
278
 
279
     BEGIN
280
 
281
          -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
282
 
283
          IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN,
284
                                    MYPACK.APACK.BPACK.ORANGE) THEN
285
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
286
                       "UNOVERLOADED ENUMERATION LITERAL BAD - B1");
287
          END IF;
288
 
289
 
290
          -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
291
 
292
          IF  MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK.
293
             APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK.
294
             BPACK.'G')) THEN
295
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
296
                       "OVERLOADED ENUMERATION LITERAL BAD - B2");
297
          END IF;
298
 
299
 
300
          -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
301
 
302
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
303
             APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK.
304
             BPACK.FALSE) THEN
305
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
306
                       "BOOLEAN BAD - B3");
307
          END IF;
308
 
309
 
310
          -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
311
 
312
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK.
313
             APACK.BPACK.SIX,2),0) THEN
314
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " &
315
                       "BAD - B4");
316
          END IF;
317
 
318
 
319
          -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
320
 
321
          IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK.
322
             APACK.BPACK.B_FLT) THEN
323
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " &
324
                       "POINT BAD - B5");
325
          END IF;
326
 
327
 
328
          -- B6: VISIBILITY FOR GENERIC INSTANCE OF
329
          --     FIXED POINT UNARY PLUS
330
 
331
          IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK.
332
             APACK.BPACK."+"(1.75))) THEN
333
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
334
                       "POINT UNARY PLUS BAD - B6");
335
          END IF;
336
 
337
 
338
          -- B7: VISIBILITY FOR GENERIC INSTANCE OF
339
          --     FIXED POINT DIVIDED BY INTEGER
340
 
341
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4),
342
             0.625) THEN
343
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
344
                       "POINT DIVIDED BY INTEGER BAD - B7");
345
          END IF;
346
 
347
 
348
          -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
349
 
350
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK.
351
             APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK.
352
             APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN
353
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " &
354
                       "EQUALITY BAD - B8");
355
          END IF;
356
 
357
 
358
          -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
359
 
360
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK.
361
             APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN
362
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " &
363
                       "EQUALITY BAD - B9");
364
          END IF;
365
 
366
 
367
          -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
368
 
369
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK.
370
             BPACK.RET_CHAR('V')) THEN
371
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " &
372
                       "EQUALITY BAD - B10");
373
          END IF;
374
 
375
 
376
          -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
377
 
378
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK.
379
             APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN
380
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
381
                       "SUBPROGRAM BAD - B11");
382
          END IF;
383
 
384
          -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
385
 
386
          MY_DO_NOTHING (MYPACK.APACK.BPACK.V1);
387
 
388
          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1,
389
                                     MYPACK.APACK.BPACK.T3(FALSE)) THEN
390
               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " &
391
                       "SUBPROGRAM BAD - B12");
392
          END IF;
393
 
394
     END B_BLOCK;
395
 
396
     RESULT;
397
END C83051A;

powered by: WebSVN 2.1.0

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