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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc1111a.ada] - Blame information for rev 309

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

Line No. Rev Author Line
1 294 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.