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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c37215f.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C37215F.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 
-- CHECK THAT IF
26 
--        A DISCRIMINANT CONSTRAINT
27 
-- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
28 
-- COMPATIBILITY WHEN THE RECORD TYPE IS:
29 
--
30 
--   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
31 
--      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
32 
 
33 
-- JBG 10/17/86
34 
-- PWN 05/31/96  Corrected format of call to "TEST"
35 
 
36 
WITH REPORT; USE REPORT;
37 
PROCEDURE C37215F IS
38 
 
39 
     SUBTYPE SM IS INTEGER RANGE 1..10;
40 
 
41 
     TYPE REC (D1, D2 : SM) IS
42 
          RECORD NULL; END RECORD;
43 
 
44 
BEGIN
45 
     TEST ("C37215F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
46 
                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
47 
                      "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT " &
48 
                      "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
49 
                      "BE CHECKED");
50 
 
51 
-- CASE D1: COMPONENT IS PRESENT
52 
 
53 
     DECLARE
54 
          TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
55 
               RECORD
56 
                    CASE D3 IS
57 
                         WHEN -5..10 =>
58 
                              C1 : REC(D3, 1);
59 
                         WHEN OTHERS =>
60 
                              C2 : INTEGER := IDENT_INT(0);
61 
                    END CASE;
62 
               END RECORD;
63 
     BEGIN
64 
          BEGIN
65 
               DECLARE
66 
                    X : CONS;
67 
               BEGIN
68 
                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
69 
                    IF X /= (1, (1, 1)) THEN
70 
                         COMMENT ("SHOULDN'T GET HERE");
71 
                    END IF;
72 
               END;
73 
          EXCEPTION
74 
               WHEN CONSTRAINT_ERROR =>
75 
                    NULL;
76 
               WHEN OTHERS =>
77 
                    FAILED ("UNEXPECTED EXCEPTION - 1");
78 
          END;
79 
 
80 
          BEGIN
81 
               DECLARE
82 
                    TYPE ACC_CONS IS ACCESS CONS;
83 
                    X : ACC_CONS;
84 
               BEGIN
85 
                    X := NEW CONS;
86 
                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
87 
                    IF X.ALL /= (1, (1, 1)) THEN
88 
                         COMMENT ("IRRELEVANT");
89 
                    END IF;
90 
               EXCEPTION
91 
                    WHEN CONSTRAINT_ERROR =>
92 
                         NULL;
93 
                    WHEN OTHERS =>
94 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
95 
               END;
96 
          EXCEPTION
97 
               WHEN OTHERS =>
98 
                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
99 
          END;
100 
 
101 
          BEGIN
102 
               DECLARE
103 
                    SUBTYPE SCONS IS CONS;
104 
               BEGIN
105 
                    DECLARE
106 
                         X : SCONS;
107 
                    BEGIN
108 
                         FAILED ("DISCRIMINANT CHECK NOT " &
109 
                                 "PERFORMED - 3");
110 
                         IF X /= (1, (1, 1)) THEN
111 
                              COMMENT ("IRRELEVANT");
112 
                         END IF;
113 
                    END;
114 
               EXCEPTION
115 
                    WHEN CONSTRAINT_ERROR =>
116 
                         NULL;
117 
                    WHEN OTHERS =>
118 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
119 
               END;
120 
          EXCEPTION
121 
               WHEN OTHERS =>
122 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
123 
          END;
124 
 
125 
          BEGIN
126 
               DECLARE
127 
                    TYPE ARR IS ARRAY (1..5) OF CONS;
128 
               BEGIN
129 
                    DECLARE
130 
                         X : ARR;
131 
                    BEGIN
132 
                         FAILED ("DISCRIMINANT CHECK NOT " &
133 
                                 "PERFORMED - 4");
134 
                         IF X /= (1..5 => (1, (1, 1))) THEN
135 
                              COMMENT ("IRRELEVANT");
136 
                         END IF;
137 
                    END;
138 
               EXCEPTION
139 
                    WHEN CONSTRAINT_ERROR =>
140 
                         NULL;
141 
                    WHEN OTHERS =>
142 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
143 
               END;
144 
          EXCEPTION
145 
               WHEN OTHERS =>
146 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
147 
          END;
148 
 
149 
          BEGIN
150 
               DECLARE
151 
                    TYPE NREC IS
152 
                         RECORD
153 
                              C1 : CONS;
154 
                         END RECORD;
155 
               BEGIN
156 
                    DECLARE
157 
                         X : NREC;
158 
                    BEGIN
159 
                         FAILED ("DISCRIMINANT CHECK NOT " &
160 
                                 "PERFORMED - 5");
161 
                         IF X /= (C1 => (1, (1, 1))) THEN
162 
                              COMMENT ("IRRELEVANT");
163 
                         END IF;
164 
                    END;
165 
               EXCEPTION
166 
                    WHEN CONSTRAINT_ERROR =>
167 
                         NULL;
168 
                    WHEN OTHERS =>
169 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
170 
               END;
171 
          EXCEPTION
172 
               WHEN OTHERS =>
173 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
174 
          END;
175 
 
176 
          BEGIN
177 
               DECLARE
178 
                    TYPE DREC IS NEW CONS;
179 
               BEGIN
180 
                    DECLARE
181 
                         X : DREC;
182 
                    BEGIN
183 
                         FAILED ("DISCRIMINANT CHECK NOT " &
184 
                                 "PERFORMED - 6");
185 
                         IF X /= (1, (1, 1)) THEN
186 
                              COMMENT ("IRRELEVANT");
187 
                         END IF;
188 
                    END;
189 
               EXCEPTION
190 
                    WHEN CONSTRAINT_ERROR =>
191 
                         NULL;
192 
                    WHEN OTHERS =>
193 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
194 
               END;
195 
          EXCEPTION
196 
               WHEN OTHERS =>
197 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
198 
          END;
199 
 
200 
     END;
201 
 
202 
-- CASE C2 : COMPONENT IS ABSENT
203 
 
204 
     DECLARE
205 
          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
206 
               RECORD
207 
                    CASE D3 IS
208 
                         WHEN -5..10 =>
209 
                              C1 : REC(D3, IDENT_INT(1));
210 
                         WHEN OTHERS =>
211 
                              C2 : INTEGER := IDENT_INT(5);
212 
                    END CASE;
213 
               END RECORD;
214 
     BEGIN
215 
          BEGIN
216 
               DECLARE
217 
                    X : CONS;
218 
               BEGIN
219 
                    IF X /= (11, 5) THEN
220 
                         FAILED ("WRONG VALUE FOR X - 11");
221 
                    END IF;
222 
               END;
223 
          EXCEPTION
224 
               WHEN OTHERS =>
225 
                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
226 
          END;
227 
 
228 
          BEGIN
229 
               DECLARE
230 
                    SUBTYPE SCONS IS CONS;
231 
               BEGIN
232 
                    DECLARE
233 
                         X : SCONS;
234 
                    BEGIN
235 
                         IF X /= (11, 5) THEN
236 
                              FAILED ("X VALUE WRONG - 12");
237 
                         END IF;
238 
                    END;
239 
               END;
240 
          EXCEPTION
241 
               WHEN OTHERS =>
242 
                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
243 
          END;
244 
 
245 
          BEGIN
246 
               DECLARE
247 
                    TYPE ARR IS ARRAY (1..5) OF CONS;
248 
                    X : ARR;
249 
               BEGIN
250 
                    IF X /= (1..5 => (11, 5)) THEN
251 
                         FAILED ("X VALUE INCORRECT - 13");
252 
                    END IF;
253 
               END;
254 
          EXCEPTION
255 
               WHEN OTHERS =>
256 
                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
257 
          END;
258 
 
259 
          BEGIN
260 
               DECLARE
261 
                    TYPE NREC IS
262 
                         RECORD
263 
                              C1 : CONS;
264 
                         END RECORD;
265 
                    X : NREC;
266 
               BEGIN
267 
                    IF X /= (C1 => (11, 5)) THEN
268 
                         FAILED ("X VALUE IS INCORRECT - 14");
269 
                    END IF;
270 
               END;
271 
          EXCEPTION
272 
               WHEN OTHERS =>
273 
                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
274 
          END;
275 
 
276 
          BEGIN
277 
               DECLARE
278 
                    TYPE NREC IS NEW CONS;
279 
                    X : NREC;
280 
               BEGIN
281 
                    IF X /= (11, 5) THEN
282 
                         FAILED ("X VALUE INCORRECT - 15");
283 
                    END IF;
284 
               END;
285 
          EXCEPTION
286 
               WHEN OTHERS =>
287 
                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
288 
          END;
289 
 
290 
          BEGIN
291 
               DECLARE
292 
                    TYPE ACC_CONS IS ACCESS CONS;
293 
                    X : ACC_CONS := NEW CONS;
294 
               BEGIN
295 
                    IF X.ALL /= (11, 5) THEN
296 
                         FAILED ("X VALUE INCORRECT - 17");
297 
                    END IF;
298 
               END;
299 
          EXCEPTION
300 
               WHEN OTHERS =>
301 
                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
302 
          END;
303 
     END;
304 
 
305 
 
306 
     RESULT;
307 
 
308 
EXCEPTION
309 
     WHEN OTHERS =>
310 
          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
311 
          RESULT;
312 
 
313 
END C37215F;

powered by: WebSVN 2.1.0

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