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

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

Line No. Rev Author Line
1 149 jeremybenn
-- C74004A.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 OPERATIONS DEPENDING ON THE FULL DECLARATION OF A
27
--     PRIVATE TYPE ARE AVAILABLE WITHIN THE PACKAGE BODY.
28
 
29
-- HISTORY:
30
--     BCB 04/05/88  CREATED ORIGINAL TEST.
31
--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
32
 
33
WITH REPORT; USE REPORT;
34
 
35
PROCEDURE C74004A IS
36
 
37
     PACKAGE P IS
38
          TYPE PR IS PRIVATE;
39
          TYPE ARR1 IS LIMITED PRIVATE;
40
          TYPE ARR2 IS PRIVATE;
41
          TYPE REC (D : INTEGER) IS PRIVATE;
42
          TYPE ACC IS PRIVATE;
43
          TYPE TSK IS LIMITED PRIVATE;
44
          TYPE FLT IS LIMITED PRIVATE;
45
          TYPE FIX IS LIMITED PRIVATE;
46
 
47
          TASK TYPE T IS
48
               ENTRY ONE(V : IN OUT INTEGER);
49
          END T;
50
 
51
          PROCEDURE CHECK (V : ARR2);
52
     PRIVATE
53
          TYPE PR IS NEW INTEGER;
54
 
55
          TYPE ARR1 IS ARRAY(1..5) OF INTEGER;
56
 
57
          TYPE ARR2 IS ARRAY(1..5) OF BOOLEAN;
58
 
59
          TYPE REC (D : INTEGER) IS RECORD
60
               COMP1 : INTEGER;
61
               COMP2 : BOOLEAN;
62
          END RECORD;
63
 
64
          TYPE ACC IS ACCESS INTEGER;
65
 
66
          TYPE TSK IS NEW T;
67
 
68
          TYPE FLT IS DIGITS 5;
69
 
70
          TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
71
     END P;
72
 
73
     PACKAGE BODY P IS
74
          X1, X2, X3 : PR;
75
          BOOL : BOOLEAN := IDENT_BOOL(FALSE);
76
          VAL : INTEGER := IDENT_INT(0);
77
          FVAL : FLOAT := 0.0;
78
          ST : STRING(1..2);
79
          O1 : ARR1 := (1,2,3,4,5);
80
          Y1 : ARR2 := (FALSE,TRUE,FALSE,TRUE,FALSE);
81
          Y2 : ARR2 := (OTHERS => TRUE);
82
          Y3 : ARR2 := (OTHERS => FALSE);
83
          Z1 : REC(0) := (0,1,FALSE);
84
          W1, W2 : ACC := NEW INTEGER'(0);
85
          V1 : TSK;
86
 
87
          TASK BODY T IS
88
          BEGIN
89
               ACCEPT ONE(V : IN OUT INTEGER) DO
90
                    V := IDENT_INT(10);
91
               END ONE;
92
          END T;
93
 
94
          PROCEDURE CHECK (V : ARR2) IS
95
          BEGIN
96
               IF V /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
97
                    FAILED ("IMPROPER VALUE PASSED AS AGGREGATE");
98
               END IF;
99
          END CHECK;
100
     BEGIN
101
          TEST ("C74004A", "CHECK THAT OPERATIONS DEPENDING ON THE " &
102
                           "FULL DECLARATION OF A PRIVATE TYPE ARE " &
103
                           "AVAILABLE WITHIN THE PACKAGE BODY");
104
 
105
          X1 := 10;
106
          X2 := 5;
107
 
108
          X3 := X1 + X2;
109
 
110
          IF X3 /= 15 THEN
111
               FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
112
          END IF;
113
 
114
          X3 := X1 - X2;
115
 
116
          IF X3 /= 5 THEN
117
               FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
118
          END IF;
119
 
120
          X3 := X1 * X2;
121
 
122
          IF X3 /= 50 THEN
123
               FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
124
          END IF;
125
 
126
          X3 := X1 / X2;
127
 
128
          IF X3 /= 2 THEN
129
               FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
130
          END IF;
131
 
132
          X3 := X1 ** 2;
133
 
134
          IF X3 /= 100 THEN
135
               FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
136
          END IF;
137
 
138
          BOOL := X1 < X2;
139
 
140
          IF BOOL THEN
141
               FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
142
          END IF;
143
 
144
          BOOL := X1 > X2;
145
 
146
          IF NOT BOOL THEN
147
               FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
148
          END IF;
149
 
150
          BOOL := X1 <= X2;
151
 
152
          IF BOOL THEN
153
               FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
154
                       "OPERATOR");
155
          END IF;
156
 
157
          BOOL := X1 >= X2;
158
 
159
          IF NOT BOOL THEN
160
               FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
161
                       "TO OPERATOR");
162
          END IF;
163
 
164
          X3 := X1 MOD X2;
165
 
166
          IF X3 /= 0 THEN
167
               FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
168
          END IF;
169
 
170
          X3 := X1 REM X2;
171
 
172
          IF X3 /= 0 THEN
173
               FAILED ("IMPROPER RESULT FROM REM OPERATOR");
174
          END IF;
175
 
176
          X3 := ABS(X1);
177
 
178
          IF X3 /= 10 THEN
179
               FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 1");
180
          END IF;
181
 
182
          X1 := -10;
183
 
184
          X3 := ABS(X1);
185
 
186
          IF X3 /= 10 THEN
187
               FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 2");
188
          END IF;
189
 
190
          X3 := PR'BASE'FIRST;
191
 
192
          IF X3 /= PR(INTEGER'FIRST) THEN
193
               FAILED ("IMPROPER RESULT FROM 'BASE'FIRST");
194
          END IF;
195
 
196
          X3 := PR'FIRST;
197
 
198
          IF X3 /= PR(INTEGER'FIRST) THEN
199
               FAILED ("IMPROPER RESULT FROM 'FIRST");
200
          END IF;
201
 
202
          VAL := PR'WIDTH;
203
 
204
          IF NOT EQUAL(VAL,INTEGER'WIDTH) THEN
205
               FAILED ("IMPROPER RESULT FROM 'WIDTH");
206
          END IF;
207
 
208
          VAL := PR'POS(X3);
209
 
210
          IF NOT EQUAL(VAL,INTEGER'FIRST) THEN
211
               FAILED ("IMPROPER RESULT FROM 'POS");
212
          END IF;
213
 
214
          X3 := PR'VAL(VAL);
215
 
216
          IF X3 /= PR(INTEGER'FIRST) THEN
217
               FAILED ("IMPROPER RESULT FROM 'VAL");
218
          END IF;
219
 
220
          X3 := PR'SUCC(X2);
221
 
222
          IF X3 /= 6 THEN
223
               FAILED ("IMPROPER RESULT FROM 'SUCC");
224
          END IF;
225
 
226
          X3 := PR'PRED(X2);
227
 
228
          IF X3 /= 4 THEN
229
               FAILED ("IMPROPER RESULT FROM 'PRED");
230
          END IF;
231
 
232
          ST := PR'IMAGE(X3);
233
 
234
          IF ST /= INTEGER'IMAGE(INTEGER(X3)) THEN
235
               FAILED ("IMPROPER RESULT FROM 'IMAGE");
236
          END IF;
237
 
238
          X3 := PR'VALUE(ST);
239
 
240
          IF X3 /= PR(INTEGER'VALUE(ST)) THEN
241
               FAILED ("IMPROPER RESULT FROM 'VALUE");
242
          END IF;
243
 
244
          CHECK ((TRUE,FALSE,TRUE,FALSE,TRUE));
245
 
246
          IF O1(2) /= IDENT_INT(2) THEN
247
               FAILED ("IMPROPER VALUE FROM INDEXING");
248
          END IF;
249
 
250
          IF O1(2..4) /= (2,3,4) THEN
251
               FAILED ("IMPROPER VALUES FROM SLICING");
252
          END IF;
253
 
254
          IF VAL IN O1'RANGE THEN
255
               FAILED ("IMPROPER RESULT FROM 'RANGE");
256
          END IF;
257
 
258
          VAL := O1'LENGTH;
259
 
260
          IF NOT EQUAL(VAL,5) THEN
261
               FAILED ("IMPROPER RESULT FROM 'LENGTH");
262
          END IF;
263
 
264
          Y3 := Y1(1..2) & Y2(3..5);
265
 
266
          IF Y3 /= (FALSE,TRUE,TRUE,TRUE,TRUE) THEN
267
               FAILED ("IMPROPER RESULT FROM CATENATION");
268
          END IF;
269
 
270
          Y3 := NOT Y1;
271
 
272
          IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
273
               FAILED ("IMPROPER RESULT FROM NOT OPERATOR");
274
          END IF;
275
 
276
          Y3 := Y1 AND Y2;
277
 
278
          IF Y3 /= (FALSE,TRUE,FALSE,TRUE,FALSE) THEN
279
               FAILED ("IMPROPER RESULT FROM AND OPERATOR");
280
          END IF;
281
 
282
          Y3 := Y1 OR Y2;
283
 
284
          IF Y3 /= (TRUE,TRUE,TRUE,TRUE,TRUE) THEN
285
               FAILED ("IMPROPER RESULT FROM OR OPERATOR");
286
          END IF;
287
 
288
          Y3 := Y1 XOR Y2;
289
 
290
          IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
291
               FAILED ("IMPROPER RESULT FROM XOR OPERATOR");
292
          END IF;
293
 
294
          VAL := Z1.COMP1;
295
 
296
          IF NOT EQUAL(VAL,1) THEN
297
               FAILED ("IMPROPER RESULT FROM SELECTION OF RECORD " &
298
                       "COMPONENTS");
299
          END IF;
300
 
301
          W1 := NEW INTEGER'(0);
302
 
303
          IF NOT EQUAL(W1.ALL,0) THEN
304
               FAILED ("IMPROPER RESULT FROM ALLOCATION");
305
          END IF;
306
 
307
          W1 := NULL;
308
 
309
          IF W1 /= NULL THEN
310
               FAILED ("IMPROPER RESULT FROM NULL LITERAL");
311
          END IF;
312
 
313
          VAL := W2.ALL;
314
 
315
          IF NOT EQUAL(VAL,0) THEN
316
               FAILED ("IMPROPER RESULT FROM SELECTED COMPONENT");
317
          END IF;
318
 
319
          BOOL := V1'CALLABLE;
320
 
321
          IF NOT BOOL THEN
322
               FAILED ("IMPROPER RESULT FROM 'CALLABLE");
323
          END IF;
324
 
325
          BOOL := V1'TERMINATED;
326
 
327
          IF BOOL THEN
328
               FAILED ("IMPROPER RESULT FROM 'TERMINATED");
329
          END IF;
330
 
331
          V1.ONE(VAL);
332
 
333
          IF NOT EQUAL(VAL,10) THEN
334
               FAILED ("IMPROPER RESULT RETURNED FROM ENTRY SELECTION");
335
          END IF;
336
 
337
          IF NOT (FLT(1.0) IN FLT) THEN
338
               FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
339
          END IF;
340
 
341
          VAL := FLT'DIGITS;
342
 
343
          IF NOT EQUAL(VAL,5) THEN
344
               FAILED ("IMPROPER RESULT FROM 'DIGITS");
345
          END IF;
346
 
347
          BOOL := FLT'MACHINE_ROUNDS;
348
 
349
          BOOL := FLT'MACHINE_OVERFLOWS;
350
 
351
          VAL := FLT'MACHINE_RADIX;
352
 
353
          VAL := FLT'MACHINE_MANTISSA;
354
 
355
          VAL := FLT'MACHINE_EMAX;
356
 
357
          VAL := FLT'MACHINE_EMIN;
358
 
359
          FVAL := FIX'DELTA;
360
 
361
          IF FVAL /= 2.0**(-1) THEN
362
               FAILED ("IMPROPER RESULT FROM 'DELTA");
363
          END IF;
364
 
365
          VAL := FIX'FORE;
366
 
367
          VAL := FIX'AFT;
368
 
369
     END P;
370
 
371
     USE P;
372
 
373
BEGIN
374
     RESULT;
375
END C74004A;

powered by: WebSVN 2.1.0

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