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/] [cc/] [cc1111a.ada] - Blame information for rev 154

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

Line No. Rev Author Line
1 149 jeremybenn
-- CC1111A.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 AFTER A GENERIC UNIT IS INSTANTIATED, THE SUBTYPE OF
27
--     AN IN OUT OBJECT PARAMETER IS DETERMINED BY THE ACTUAL PARAMETER
28
--     (TESTS INTEGER, ENUMERATION, FLOATING POINT, FIXED POINT, ARRAY,
29
--     ACCESS, AND DISCRIMINATED TYPES).
30
 
31
-- HISTORY:
32
--     BCB 03/28/88  CREATED ORIGINAL TEST.
33
--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
34
 
35
WITH REPORT; USE REPORT;
36
 
37
PROCEDURE CC1111A IS
38
 
39
     SUBTYPE INT IS INTEGER RANGE 0..5;
40
     INTVAR : INTEGER RANGE 1..3;
41
 
42
     TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT);
43
     SUBTYPE SUBENUM IS ENUM RANGE ONE .. FIVE;
44
     ENUMVAR : ENUM RANGE TWO .. THREE;
45
 
46
     TYPE FLT IS DIGITS 5 RANGE -5.0 .. 5.0;
47
     SUBTYPE SUBFLT IS FLT RANGE -1.0 .. 1.0;
48
     FLTVAR : FLT RANGE 0.0 .. 1.0;
49
 
50
     TYPE FIX IS DELTA 0.5 RANGE -5.0 .. 5.0;
51
     SUBTYPE SUBFIX IS FIX RANGE -1.0 .. 1.0;
52
     FIXVAR : FIX RANGE 0.0 .. 1.0;
53
 
54
     SUBTYPE STR IS STRING (1..10);
55
     STRVAR : STRING (1..5);
56
 
57
     TYPE REC (DISC : INTEGER := 5) IS RECORD
58
          NULL;
59
     END RECORD;
60
     SUBTYPE SUBREC IS REC (6);
61
     RECVAR : REC(5);
62
     SUBRECVAR : SUBREC;
63
 
64
     TYPE ACCREC IS ACCESS REC;
65
     SUBTYPE A1 IS ACCREC(1);
66
     SUBTYPE A2 IS ACCREC(2);
67
     A1VAR : A1 := NEW REC(1);
68
     A2VAR : A2 := NEW REC(2);
69
 
70
     PACKAGE P IS
71
          TYPE PRIV IS PRIVATE;
72
     PRIVATE
73
          TYPE PRIV IS RANGE 1 .. 100;
74
          SUBTYPE SUBPRIV IS PRIV RANGE 5 .. 10;
75
          PRIVVAR : PRIV RANGE 8 .. 10;
76
     END P;
77
 
78
     PACKAGE BODY P IS
79
          FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN;
80
 
81
          FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN IS
82
          BEGIN
83
               RETURN ONE = TWO;
84
          END PRIVEQUAL;
85
 
86
          GENERIC
87
               INPUT : SUBPRIV;
88
               OUTPUT : IN OUT SUBPRIV;
89
          PROCEDURE I;
90
 
91
          PROCEDURE I IS
92
          BEGIN
93
               OUTPUT := INPUT;
94
               FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
95
                       "PRIVATE TYPE");
96
               IF PRIVEQUAL (OUTPUT, OUTPUT) THEN
97
                    COMMENT ("DON'T OPTIMIZE OUTPUT");
98
               END IF;
99
          EXCEPTION
100
               WHEN CONSTRAINT_ERROR =>
101
                    NULL;
102
               WHEN OTHERS =>
103
                    FAILED ("WRONG EXCEPTION RAISED");
104
          END I;
105
 
106
          PROCEDURE I1 IS NEW I (5, PRIVVAR);
107
          PROCEDURE I2 IS NEW I (SUBPRIV'FIRST, PRIVVAR);
108
 
109
     BEGIN
110
          TEST ("CC1111A", "CHECK THAT AFTER A GENERIC UNIT IS " &
111
                           "INSTANTIATED, THE SUBTYPE OF AN IN OUT " &
112
                           "OBJECT PARAMETER IS DETERMINED BY THE " &
113
                           "ACTUAL PARAMETER (TESTS INTEGER, " &
114
                           "ENUMERATION, FLOATING POINT, FIXED POINT " &
115
                           ", ARRAY, ACCESS, AND DISCRIMINATED TYPES)");
116
 
117
          I1;
118
          I2;
119
     END P;
120
 
121
     USE P;
122
 
123
     GENERIC
124
          TYPE GP IS PRIVATE;
125
     FUNCTION GEN_IDENT (X : GP) RETURN GP;
126
 
127
     GENERIC
128
          INPUT : INT;
129
          OUTPUT : IN OUT INT;
130
     PROCEDURE B;
131
 
132
     GENERIC
133
          INPUT : SUBENUM;
134
          OUTPUT : IN OUT SUBENUM;
135
     PROCEDURE C;
136
 
137
     GENERIC
138
          INPUT : SUBFLT;
139
          OUTPUT : IN OUT SUBFLT;
140
     PROCEDURE D;
141
 
142
     GENERIC
143
          INPUT : SUBFIX;
144
          OUTPUT : IN OUT SUBFIX;
145
     PROCEDURE E;
146
 
147
     GENERIC
148
          INPUT : STR;
149
          OUTPUT : IN OUT STR;
150
     PROCEDURE F;
151
 
152
     GENERIC
153
          INPUT : A1;
154
          OUTPUT : IN OUT A1;
155
     PROCEDURE G;
156
 
157
     GENERIC
158
          INPUT : SUBREC;
159
          OUTPUT : IN OUT SUBREC;
160
     PROCEDURE H;
161
 
162
     GENERIC
163
          TYPE GP IS PRIVATE;
164
     FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN;
165
 
166
     FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN IS
167
     BEGIN
168
          RETURN ONE = TWO;
169
     END GENEQUAL;
170
 
171
     FUNCTION GEN_IDENT (X : GP) RETURN GP IS
172
     BEGIN
173
               RETURN X;
174
     END GEN_IDENT;
175
 
176
     FUNCTION INT_IDENT IS NEW GEN_IDENT (INT);
177
     FUNCTION SUBENUM_IDENT IS NEW GEN_IDENT (SUBENUM);
178
     FUNCTION SUBFLT_IDENT IS NEW GEN_IDENT (SUBFLT);
179
     FUNCTION SUBFIX_IDENT IS NEW GEN_IDENT (SUBFIX);
180
 
181
     FUNCTION ENUMEQUAL IS NEW GENEQUAL (SUBENUM);
182
     FUNCTION FLTEQUAL IS NEW GENEQUAL (SUBFLT);
183
     FUNCTION FIXEQUAL IS NEW GENEQUAL (SUBFIX);
184
     FUNCTION STREQUAL IS NEW GENEQUAL (STR);
185
     FUNCTION ACCEQUAL IS NEW GENEQUAL (A2);
186
     FUNCTION RECEQUAL IS NEW GENEQUAL (REC);
187
 
188
     PROCEDURE B IS
189
     BEGIN
190
          OUTPUT := INPUT;
191
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
192
                  "INTEGER TYPE");
193
          IF EQUAL (OUTPUT, OUTPUT) THEN
194
               COMMENT ("DON'T OPTIMIZE OUTPUT");
195
          END IF;
196
     EXCEPTION
197
          WHEN CONSTRAINT_ERROR =>
198
               NULL;
199
          WHEN OTHERS =>
200
               FAILED ("WRONG EXCEPTION RAISED");
201
     END B;
202
 
203
     PROCEDURE C IS
204
     BEGIN
205
          OUTPUT := INPUT;
206
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
207
                  "ENUMERATION TYPE");
208
          IF ENUMEQUAL (OUTPUT, OUTPUT) THEN
209
               COMMENT ("DON'T OPTIMIZE OUTPUT");
210
          END IF;
211
     EXCEPTION
212
          WHEN CONSTRAINT_ERROR =>
213
               NULL;
214
          WHEN OTHERS =>
215
               FAILED ("WRONG EXCEPTION RAISED");
216
     END C;
217
 
218
     PROCEDURE D IS
219
     BEGIN
220
          OUTPUT := INPUT;
221
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
222
                  "FLOATING POINT TYPE");
223
          IF FLTEQUAL (OUTPUT, OUTPUT) THEN
224
               COMMENT ("DON'T OPTIMIZE OUTPUT");
225
          END IF;
226
     EXCEPTION
227
          WHEN CONSTRAINT_ERROR =>
228
               NULL;
229
          WHEN OTHERS =>
230
               FAILED ("WRONG EXCEPTION RAISED");
231
     END D;
232
 
233
     PROCEDURE E IS
234
     BEGIN
235
          OUTPUT := INPUT;
236
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
237
                  "FIXED POINT TYPE");
238
          IF FIXEQUAL (OUTPUT, OUTPUT) THEN
239
               COMMENT ("DON'T OPTIMIZE OUTPUT");
240
          END IF;
241
     EXCEPTION
242
          WHEN CONSTRAINT_ERROR =>
243
               NULL;
244
          WHEN OTHERS =>
245
               FAILED ("WRONG EXCEPTION RAISED");
246
     END E;
247
 
248
     PROCEDURE F IS
249
     BEGIN
250
          OUTPUT := INPUT;
251
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
252
                  "ARRAY TYPE");
253
          IF STREQUAL (OUTPUT, OUTPUT) THEN
254
               COMMENT ("DON'T OPTIMIZE OUTPUT");
255
          END IF;
256
     EXCEPTION
257
          WHEN CONSTRAINT_ERROR =>
258
               NULL;
259
          WHEN OTHERS =>
260
               FAILED ("WRONG EXCEPTION RAISED");
261
     END F;
262
 
263
     PROCEDURE G IS
264
     BEGIN
265
          OUTPUT := INPUT;
266
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
267
                  "ACCESS TYPE");
268
          IF ACCEQUAL (OUTPUT, OUTPUT) THEN
269
               COMMENT ("DON'T OPTIMIZE OUTPUT");
270
          END IF;
271
     EXCEPTION
272
          WHEN CONSTRAINT_ERROR =>
273
               NULL;
274
          WHEN OTHERS =>
275
               FAILED ("WRONG EXCEPTION RAISED");
276
     END G;
277
 
278
     PROCEDURE H IS
279
     BEGIN
280
          OUTPUT := INPUT;
281
          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
282
                  "DISCRIMINATED RECORD TYPE");
283
          IF RECEQUAL (OUTPUT, OUTPUT) THEN
284
               COMMENT ("DON'T OPTIMIZE OUTPUT");
285
          END IF;
286
     EXCEPTION
287
          WHEN CONSTRAINT_ERROR =>
288
               NULL;
289
          WHEN OTHERS =>
290
               FAILED ("WRONG EXCEPTION RAISED");
291
     END H;
292
 
293
     PROCEDURE B1 IS NEW B (4, INTVAR);
294
     PROCEDURE C1 IS NEW C (FOUR, ENUMVAR);
295
     PROCEDURE D1 IS NEW D (-1.0, FLTVAR);
296
     PROCEDURE E1 IS NEW E (-1.0, FIXVAR);
297
     PROCEDURE F1 IS NEW F ("9876543210", STRVAR);
298
     PROCEDURE G1 IS NEW G (A1VAR, A2VAR);
299
     PROCEDURE H1 IS NEW H (SUBRECVAR, RECVAR);
300
 
301
     PROCEDURE B2 IS NEW B (INT_IDENT(INT'FIRST), INTVAR);
302
     PROCEDURE C2 IS NEW C (SUBENUM_IDENT(SUBENUM'FIRST), ENUMVAR);
303
     PROCEDURE D2 IS NEW D (SUBFLT_IDENT(SUBFLT'FIRST), FLTVAR);
304
     PROCEDURE E2 IS NEW E (SUBFIX_IDENT(SUBFIX'FIRST), FIXVAR);
305
 
306
BEGIN
307
 
308
     B1;
309
     C1;
310
     D1;
311
     E1;
312
     F1;
313
     G1;
314
     H1;
315
 
316
     B2;
317
     C2;
318
     D2;
319
     E2;
320
 
321
     RESULT;
322
END CC1111A;

powered by: WebSVN 2.1.0

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