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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C74302B.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 WHEN THE FULL DECLARATION OF A DEFERRED CONSTANT IS
27
--     GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION
28
--     IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT.  (USE ENUMERATION,
29
--     INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING
30
--     USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE
31
--     TYPES AS FULL DECLARATION OF PRIVATE TYPE)
32
 
33
-- HISTORY:
34
--     BCB 07/25/88  CREATED ORIGINAL TEST.
35
 
36
WITH REPORT; USE REPORT;
37
 
38
PROCEDURE C74302B IS
39
 
40
     TYPE ARR_RAN IS RANGE 1..2;
41
 
42
     BUMP : INTEGER := IDENT_INT(0);
43
 
44
     GENERIC
45
          TYPE DT IS (<>);
46
     FUNCTION F1 RETURN DT;
47
 
48
     GENERIC
49
          TYPE FE IS DELTA <>;
50
     FUNCTION F2 RETURN FE;
51
 
52
     GENERIC
53
          TYPE FLE IS DIGITS <>;
54
     FUNCTION F3 RETURN FLE;
55
 
56
     GENERIC
57
          TYPE CA IS ARRAY(ARR_RAN) OF INTEGER;
58
     FUNCTION F4 RETURN CA;
59
 
60
     GENERIC
61
          TYPE GP IS LIMITED PRIVATE;
62
     FUNCTION F5 (V : GP) RETURN GP;
63
 
64
     GENERIC
65
          TYPE GP1 IS LIMITED PRIVATE;
66
     FUNCTION F6 (V1 : GP1) RETURN GP1;
67
 
68
     GENERIC
69
          TYPE AC IS ACCESS INTEGER;
70
     FUNCTION F7 RETURN AC;
71
 
72
     GENERIC
73
          TYPE PP IS PRIVATE;
74
     FUNCTION F8 (P1 : PP) RETURN PP;
75
 
76
     FUNCTION F1 RETURN DT IS
77
     BEGIN
78
          BUMP := BUMP + 1;
79
          RETURN DT'VAL(BUMP);
80
     END F1;
81
 
82
     FUNCTION F2 RETURN FE IS
83
     BEGIN
84
          BUMP := BUMP + 1;
85
          RETURN FE(BUMP);
86
     END F2;
87
 
88
     FUNCTION F3 RETURN FLE IS
89
     BEGIN
90
          BUMP := BUMP + 1;
91
          RETURN FLE(BUMP);
92
     END F3;
93
 
94
     FUNCTION F4 RETURN CA IS
95
     BEGIN
96
          BUMP := BUMP + 1;
97
          RETURN ((BUMP,BUMP-1));
98
     END F4;
99
 
100
     FUNCTION F5 (V : GP) RETURN GP IS
101
     BEGIN
102
          BUMP := BUMP + 1;
103
          RETURN V;
104
     END F5;
105
 
106
     FUNCTION F6 (V1 : GP1) RETURN GP1 IS
107
     BEGIN
108
          BUMP := BUMP + 1;
109
          RETURN V1;
110
     END F6;
111
 
112
     FUNCTION F7 RETURN AC IS
113
          VAR : AC;
114
     BEGIN
115
          BUMP := BUMP + 1;
116
          VAR := NEW INTEGER'(BUMP);
117
          RETURN VAR;
118
     END F7;
119
 
120
     FUNCTION F8 (P1 : PP) RETURN PP IS
121
     BEGIN
122
          BUMP := BUMP + 1;
123
          RETURN P1;
124
     END F8;
125
 
126
     PACKAGE PACK IS
127
          TYPE SP IS PRIVATE;
128
          CONS : CONSTANT SP;
129
     PRIVATE
130
          TYPE SP IS RANGE 1 .. 100;
131
          CONS : CONSTANT SP := 50;
132
     END PACK;
133
 
134
     USE PACK;
135
 
136
     PACKAGE P IS
137
          TYPE INT IS PRIVATE;
138
          TYPE ENUM IS PRIVATE;
139
          TYPE FIX IS PRIVATE;
140
          TYPE FLT IS PRIVATE;
141
          TYPE CON_ARR IS PRIVATE;
142
          TYPE REC IS PRIVATE;
143
          TYPE REC1 IS PRIVATE;
144
          TYPE ACC IS PRIVATE;
145
          TYPE PRIV IS PRIVATE;
146
 
147
          GENERIC
148
               TYPE LP IS PRIVATE;
149
          FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;
150
 
151
          I1, I2, I3, I4 : CONSTANT INT;
152
          E1, E2, E3, E4 : CONSTANT ENUM;
153
          FI1, FI2, FI3, FI4 : CONSTANT FIX;
154
          FL1, FL2, FL3, FL4 : CONSTANT FLT;
155
          CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;
156
          R1, R2, R3, R4 : CONSTANT REC;
157
          R1A, R2A, R3A, R4A : CONSTANT REC1;
158
          A1, A2, A3, A4 : CONSTANT ACC;
159
          PR1, PR2, PR3, PR4 : CONSTANT PRIV;
160
     PRIVATE
161
          TYPE INT IS RANGE 1 .. 100;
162
 
163
          TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
164
 
165
          TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
166
 
167
          TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;
168
 
169
          TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;
170
 
171
          TYPE REC IS RECORD
172
               COMP1 : INTEGER;
173
               COMP2 : INTEGER;
174
               COMP3 : BOOLEAN;
175
          END RECORD;
176
 
177
          TYPE REC1 IS RECORD
178
               COMP1 : INTEGER := 10;
179
               COMP2 : INTEGER := 20;
180
               COMP3 : BOOLEAN := FALSE;
181
          END RECORD;
182
 
183
          TYPE ACC IS ACCESS INTEGER;
184
 
185
          TYPE PRIV IS NEW SP;
186
 
187
          FUNCTION DDT IS NEW F1 (INT);
188
          FUNCTION EDT IS NEW F1 (ENUM);
189
          FUNCTION FDT IS NEW F2 (FIX);
190
          FUNCTION FLDT IS NEW F3 (FLT);
191
          FUNCTION CADT IS NEW F4 (CON_ARR);
192
          FUNCTION RDT IS NEW F5 (REC);
193
          FUNCTION R1DT IS NEW F6 (REC1);
194
          FUNCTION ADT IS NEW F7 (ACC);
195
          FUNCTION PDT IS NEW F8 (PRIV);
196
 
197
          REC_OBJ : REC := (1,2,TRUE);
198
          REC1_OBJ : REC1 := (3,4,FALSE);
199
 
200
          I1, I2, I3, I4 : CONSTANT INT := DDT;
201
          E1, E2, E3, E4 : CONSTANT ENUM := EDT;
202
          FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;
203
          FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;
204
          CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;
205
          R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);
206
          R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);
207
          A1, A2, A3, A4 : CONSTANT ACC := ADT;
208
          PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));
209
     END P;
210
 
211
     PACKAGE BODY P IS
212
          AVAR1 : ACC := NEW INTEGER'(29);
213
          AVAR2 : ACC := NEW INTEGER'(30);
214
          AVAR3 : ACC := NEW INTEGER'(31);
215
          AVAR4 : ACC := NEW INTEGER'(32);
216
 
217
          FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS
218
          BEGIN
219
               RETURN Z1 = Z2;
220
          END GEN_EQUAL;
221
 
222
          FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);
223
          FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);
224
          FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);
225
          FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);
226
          FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);
227
          FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);
228
          FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
229
          FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);
230
          FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);
231
     BEGIN
232
          TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &
233
                           "A DEFERRED CONSTANT IS GIVEN AS A " &
234
                           "MULTIPLE DECLARATION, THE INITIALIZATION " &
235
                           "EXPRESSION IS EVALUATED ONCE FOR EACH " &
236
                           "DEFERRED CONSTANT");
237
 
238
          IF NOT EQUAL(BUMP,36) THEN
239
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
240
                       "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");
241
          END IF;
242
 
243
          IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR
244
             NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN
245
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
246
                       "DEFERRED INTEGER CONSTANTS");
247
          END IF;
248
 
249
          IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR
250
             NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN
251
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
252
                       "DEFERRED ENUMERATION CONSTANTS");
253
          END IF;
254
 
255
          IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR
256
             NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN
257
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
258
                       "DEFERRED FIXED POINT CONSTANTS");
259
          END IF;
260
 
261
          IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR
262
             NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN
263
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
264
                       "DEFERRED FLOATING POINT CONSTANTS");
265
          END IF;
266
 
267
          IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))
268
           OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))
269
               THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
270
                            "DEFERRED ARRAY CONSTANTS");
271
          END IF;
272
 
273
          IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)
274
             OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)
275
               THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
276
                            "DEFERRED RECORD CONSTANTS");
277
          END IF;
278
 
279
          IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,
280
             REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT
281
             REC1_EQUAL(R4A,REC1_OBJ) THEN
282
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
283
                       "DEFERRED RECORD CONSTANTS WITH DEFAULT " &
284
                       "EXPRESSIONS");
285
          END IF;
286
 
287
          IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,
288
             AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT
289
             ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN
290
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
291
                       "DEFERRED ACCESS CONSTANTS");
292
          END IF;
293
 
294
          IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,
295
             PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT
296
             PRIV_EQUAL(PR4,PRIV(CONS)) THEN
297
               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
298
                       "DEFERRED PRIVATE CONSTANTS");
299
          END IF;
300
 
301
          RESULT;
302
     END P;
303
 
304
     USE P;
305
 
306
BEGIN
307
     NULL;
308
END C74302B;

powered by: WebSVN 2.1.0

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