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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c7/] [c74306a.ada] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C74306A.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
--     AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF
27
--     THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY
28
--     EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL
29
--     DECLARATION.
30
 
31
-- HISTORY:
32
--     BCB 03/14/88  CREATED ORIGINAL TEST.
33
 
34
WITH REPORT; USE REPORT;
35
 
36
PROCEDURE C74306A IS
37
 
38
     GENERIC
39
          TYPE GENERAL_PURPOSE IS LIMITED PRIVATE;
40
          Y : IN OUT GENERAL_PURPOSE;
41
     FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
42
 
43
     FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
44
     BEGIN
45
          IF EQUAL(3,3) THEN
46
               RETURN X;
47
          END IF;
48
          RETURN Y;
49
     END IDENT;
50
 
51
     PACKAGE P IS
52
          TYPE T IS PRIVATE;
53
          C : CONSTANT T;
54
     PRIVATE
55
          TYPE T IS RANGE 1 .. 100;
56
 
57
          TYPE A IS ARRAY(1..2) OF T;
58
 
59
          TYPE B IS ARRAY(INTEGER RANGE <>) OF T;
60
 
61
          TYPE D (DISC : T) IS RECORD
62
               NULL;
63
          END RECORD;
64
 
65
          C : CONSTANT T := 50;
66
 
67
          PARAM : T := 99;
68
 
69
          FUNCTION IDENT_T IS NEW IDENT (T, PARAM);
70
 
71
          FUNCTION F (X : T := C) RETURN T;
72
 
73
          SUBTYPE RAN IS T RANGE 1 .. C;
74
 
75
          SUBTYPE IND IS B(1..INTEGER(C));
76
 
77
          SUBTYPE DIS IS D (DISC => C);
78
 
79
          OBJ : T := C;
80
 
81
          CON : CONSTANT T := C;
82
 
83
          ARR : A := (5, C);
84
 
85
          PAR : T := IDENT_T (C);
86
 
87
          RANOBJ : T RANGE 1 .. C := C;
88
 
89
          INDOBJ : B(1..INTEGER(C));
90
 
91
          DIS_VAL : DIS;
92
 
93
          REN : T RENAMES C;
94
 
95
          GENERIC
96
               FOR_PAR : T := C;
97
          PACKAGE GENPACK IS
98
               VAL : T;
99
          END GENPACK;
100
 
101
          GENERIC
102
               IN_PAR : IN T;
103
          PACKAGE NEWPACK IS
104
               IN_VAL : T;
105
          END NEWPACK;
106
     END P;
107
 
108
     USE P;
109
 
110
     PACKAGE BODY P IS
111
          TYPE A1 IS ARRAY(1..2) OF T;
112
 
113
          TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T;
114
 
115
          TYPE D1 (DISC1 : T) IS RECORD
116
               NULL;
117
          END RECORD;
118
 
119
          SUBTYPE RAN1 IS T RANGE 1 .. C;
120
 
121
          SUBTYPE IND1 IS B1(1..INTEGER(C));
122
 
123
          SUBTYPE DIS1 IS D1 (DISC1 => C);
124
 
125
          OBJ1 : T := C;
126
 
127
          FUNCVAR : T;
128
 
129
          CON1 : CONSTANT T := C;
130
 
131
          ARR1 : A1 := (5, C);
132
 
133
          PAR1 : T := IDENT_T (C);
134
 
135
          RANOBJ1 : T RANGE 1 .. C := C;
136
 
137
          INDOBJ1 : B1(1..INTEGER(C));
138
 
139
          DIS_VAL1 : DIS1;
140
 
141
          REN1 : T RENAMES C;
142
 
143
          FUNCTION F (X : T := C) RETURN T IS
144
          BEGIN
145
               RETURN C;
146
          END F;
147
 
148
          PACKAGE BODY GENPACK IS
149
          BEGIN
150
               VAL := FOR_PAR;
151
          END GENPACK;
152
 
153
          PACKAGE BODY NEWPACK IS
154
          BEGIN
155
               IN_VAL := IN_PAR;
156
          END NEWPACK;
157
 
158
          PACKAGE PACK IS NEW GENPACK (FOR_PAR => C);
159
 
160
          PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C);
161
     BEGIN
162
          TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " &
163
                           "CONSTANT, THE VALUE OF THE CONSTANT MAY " &
164
                           "BE USED IN ANY EXPRESSION, PARTICULARLY " &
165
                           "EXPRESSIONS IN WHICH THE USE WOULD BE " &
166
                           "ILLEGAL BEFORE THE FULL DECLARATION");
167
 
168
          IF OBJ /= IDENT_T(50) THEN
169
               FAILED ("IMPROPER VALUE FOR OBJ");
170
          END IF;
171
 
172
          IF CON /= IDENT_T(50) THEN
173
               FAILED ("IMPROPER VALUE FOR CON");
174
          END IF;
175
 
176
          IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN
177
               FAILED ("IMPROPER VALUES FOR ARR");
178
          END IF;
179
 
180
          IF PAR /= IDENT_T(50) THEN
181
               FAILED ("IMPROPER VALUE FOR PAR");
182
          END IF;
183
 
184
          IF OBJ1 /= IDENT_T(50) THEN
185
               FAILED ("IMPROPER VALUE FOR OBJ1");
186
          END IF;
187
 
188
          IF CON1 /= IDENT_T(50) THEN
189
               FAILED ("IMPROPER VALUE FOR CON1");
190
          END IF;
191
 
192
          IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN
193
               FAILED ("IMPROPER VALUES FOR ARR1");
194
          END IF;
195
 
196
          IF PAR1 /= IDENT_T(50) THEN
197
               FAILED ("IMPROPER VALUE FOR PAR1");
198
          END IF;
199
 
200
          IF PACK.VAL /= IDENT_T(50) THEN
201
               FAILED ("IMPROPER VALUE FOR PACK.VAL");
202
          END IF;
203
 
204
          IF NPACK.IN_VAL /= IDENT_T(50) THEN
205
               FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL");
206
          END IF;
207
 
208
          IF RAN'LAST /= IDENT_T(50) THEN
209
               FAILED ("IMPROPER VALUE FOR RAN'LAST");
210
          END IF;
211
 
212
          IF RANOBJ /= IDENT_T(50) THEN
213
               FAILED ("IMPROPER VALUE FOR RANOBJ");
214
          END IF;
215
 
216
          IF IND'LAST /= IDENT_INT(50) THEN
217
               FAILED ("IMPROPER VALUE FOR IND'LAST");
218
          END IF;
219
 
220
          IF INDOBJ'LAST /= IDENT_INT(50) THEN
221
               FAILED ("IMPROPER VALUE FOR INDOBJ'LAST");
222
          END IF;
223
 
224
          IF DIS_VAL.DISC /= IDENT_T(50) THEN
225
               FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC");
226
          END IF;
227
 
228
          IF REN /= IDENT_T(50) THEN
229
               FAILED ("IMPROPER VALUE FOR REN");
230
          END IF;
231
 
232
          IF RAN1'LAST /= IDENT_T(50) THEN
233
               FAILED ("IMPROPER VALUE FOR RAN1'LAST");
234
          END IF;
235
 
236
          IF RANOBJ1 /= IDENT_T(50) THEN
237
               FAILED ("IMPROPER VALUE FOR RANOBJ1");
238
          END IF;
239
 
240
          IF IND1'LAST /= IDENT_INT(50) THEN
241
               FAILED ("IMPROPER VALUE FOR IND1'LAST");
242
          END IF;
243
 
244
          IF INDOBJ1'LAST /= IDENT_INT(50) THEN
245
               FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST");
246
          END IF;
247
 
248
          IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN
249
               FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1");
250
          END IF;
251
 
252
          IF REN1 /= IDENT_T(50) THEN
253
               FAILED ("IMPROPER VALUE FOR REN1");
254
          END IF;
255
 
256
          FUNCVAR := F(C);
257
 
258
          IF FUNCVAR /= IDENT_T(50) THEN
259
               FAILED ("IMPROPER VALUE FOR FUNCVAR");
260
          END IF;
261
 
262
          RESULT;
263
     END P;
264
 
265
BEGIN
266
     DECLARE
267
          TYPE ARR IS ARRAY(1..2) OF T;
268
 
269
          VAL1 : T := C;
270
 
271
          VAL2 : ARR := (C, C);
272
 
273
          VAL3 : T RENAMES C;
274
     BEGIN
275
          NULL;
276
     END;
277
 
278
     NULL;
279
END C74306A;

powered by: WebSVN 2.1.0

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