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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C34005S.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 THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
27 
--     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
28 
--     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 1 OF 2
29 
--     TESTS WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST
30 
--     C34005V.
31 
 
32 
-- HISTORY:
33 
--     JRK 08/20/87  CREATED ORIGINAL TEST.
34 
--     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34005S.ADA AND
35 
--                   C34005V.ADA
36 
--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
37 
 
38 
WITH SYSTEM; USE SYSTEM;
39 
WITH REPORT; USE REPORT;
40 
 
41 
PROCEDURE C34005S IS
42 
 
43 
     PACKAGE PKG_L IS
44 
 
45 
          TYPE LP IS LIMITED PRIVATE;
46 
 
47 
          FUNCTION CREATE (X : INTEGER) RETURN LP;
48 
 
49 
          FUNCTION VALUE (X : LP) RETURN INTEGER;
50 
 
51 
          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
52 
 
53 
          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
54 
 
55 
          C1  : CONSTANT LP;
56 
          C2  : CONSTANT LP;
57 
          C3  : CONSTANT LP;
58 
          C4  : CONSTANT LP;
59 
          C5  : CONSTANT LP;
60 
          C6  : CONSTANT LP;
61 
          C7  : CONSTANT LP;
62 
          C8  : CONSTANT LP;
63 
          C9  : CONSTANT LP;
64 
          C10 : CONSTANT LP;
65 
          C11 : CONSTANT LP;
66 
          C12 : CONSTANT LP;
67 
          C13 : CONSTANT LP;
68 
          C14 : CONSTANT LP;
69 
 
70 
     PRIVATE
71 
 
72 
          TYPE LP IS NEW INTEGER;
73 
 
74 
          C1  : CONSTANT LP :=  1;
75 
          C2  : CONSTANT LP :=  2;
76 
          C3  : CONSTANT LP :=  3;
77 
          C4  : CONSTANT LP :=  4;
78 
          C5  : CONSTANT LP :=  5;
79 
          C6  : CONSTANT LP :=  6;
80 
          C7  : CONSTANT LP :=  7;
81 
          C8  : CONSTANT LP :=  8;
82 
          C9  : CONSTANT LP :=  9;
83 
          C10 : CONSTANT LP := 10;
84 
          C11 : CONSTANT LP := 11;
85 
          C12 : CONSTANT LP := 12;
86 
          C13 : CONSTANT LP := 13;
87 
          C14 : CONSTANT LP := 14;
88 
 
89 
     END PKG_L;
90 
 
91 
     USE PKG_L;
92 
 
93 
     SUBTYPE COMPONENT IS LP;
94 
 
95 
     PACKAGE PKG_P IS
96 
 
97 
          FIRST : CONSTANT := 0;
98 
          LAST  : CONSTANT := 10;
99 
 
100 
          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
101 
 
102 
          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
103 
                               COMPONENT;
104 
 
105 
          FUNCTION CREATE ( F1, L1 : INDEX;
106 
                            F2, L2 : INDEX;
107 
                            C      : COMPONENT;
108 
                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
109 
                          ) RETURN PARENT;
110 
 
111 
          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
112 
 
113 
     END PKG_P;
114 
 
115 
     USE PKG_P;
116 
 
117 
     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
118 
                           IDENT_INT (6) .. IDENT_INT (8));
119 
 
120 
     TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
121 
                        COMPONENT;
122 
 
123 
     SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
124 
 
125 
     X : T;
126 
     W : PARENT (4 .. 5, 6 .. 8);
127 
     C : COMPONENT;
128 
     B : BOOLEAN := FALSE;
129 
     U : ARR;
130 
     N : CONSTANT := 2;
131 
 
132 
     PROCEDURE A (X : ADDRESS) IS
133 
     BEGIN
134 
          B := IDENT_BOOL (TRUE);
135 
     END A;
136 
 
137 
     FUNCTION V RETURN T IS
138 
          RESULT : T;
139 
     BEGIN
140 
          FOR I IN RESULT'RANGE LOOP
141 
               FOR J IN RESULT'RANGE(2) LOOP
142 
                    ASSIGN (RESULT (I, J), C);
143 
               END LOOP;
144 
          END LOOP;
145 
          RETURN RESULT;
146 
     END V;
147 
 
148 
     PACKAGE BODY PKG_L IS
149 
 
150 
          FUNCTION CREATE (X : INTEGER) RETURN LP IS
151 
          BEGIN
152 
               RETURN LP (IDENT_INT (X));
153 
          END CREATE;
154 
 
155 
          FUNCTION VALUE (X : LP) RETURN INTEGER IS
156 
          BEGIN
157 
               RETURN INTEGER (X);
158 
          END VALUE;
159 
 
160 
          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
161 
          BEGIN
162 
               RETURN X = Y;
163 
          END EQUAL;
164 
 
165 
          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
166 
          BEGIN
167 
               X := Y;
168 
          END ASSIGN;
169 
 
170 
     END PKG_L;
171 
 
172 
     PACKAGE BODY PKG_P IS
173 
 
174 
          FUNCTION CREATE
175 
             ( F1, L1 : INDEX;
176 
               F2, L2 : INDEX;
177 
               C      : COMPONENT;
178 
               DUMMY  : PARENT
179 
             ) RETURN PARENT
180 
          IS
181 
               A : PARENT (F1 .. L1, F2 .. L2);
182 
               B : COMPONENT;
183 
          BEGIN
184 
               ASSIGN (B, C);
185 
               FOR I IN F1 .. L1 LOOP
186 
                    FOR J IN F2 .. L2 LOOP
187 
                         ASSIGN (A (I, J), B);
188 
                         ASSIGN (B, CREATE (VALUE (B) + 1));
189 
                    END LOOP;
190 
               END LOOP;
191 
               RETURN A;
192 
          END CREATE;
193 
 
194 
          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
195 
          BEGIN
196 
               IF X'LENGTH /= Y'LENGTH OR
197 
                  X'LENGTH(2) /= Y'LENGTH(2) THEN
198 
                    RETURN FALSE;
199 
               ELSE FOR I IN X'RANGE LOOP
200 
                         FOR J IN X'RANGE(2) LOOP
201 
                              IF NOT EQUAL (X (I, J),
202 
                                            Y (I - X'FIRST + Y'FIRST,
203 
                                               J - X'FIRST(2) +
204 
                                                   Y'FIRST(2))) THEN
205 
                                   RETURN FALSE;
206 
                              END IF;
207 
                         END LOOP;
208 
                    END LOOP;
209 
               END IF;
210 
               RETURN TRUE;
211 
          END EQUAL;
212 
 
213 
     END PKG_P;
214 
 
215 
     FUNCTION EQUAL (X, Y : ARRT) RETURN BOOLEAN IS
216 
     BEGIN
217 
          IF X'LENGTH /= Y'LENGTH OR X'LENGTH(2) /= Y'LENGTH(2) THEN
218 
               RETURN FALSE;
219 
          ELSE FOR I IN X'RANGE LOOP
220 
                    FOR J IN X'RANGE(2) LOOP
221 
                         IF NOT EQUAL (X (I, J),
222 
                                       Y (I - X'FIRST + Y'FIRST,
223 
                                          J - X'FIRST(2) +
224 
                                              Y'FIRST(2))) THEN
225 
                              RETURN FALSE;
226 
                         END IF;
227 
                    END LOOP;
228 
               END LOOP;
229 
          END IF;
230 
          RETURN TRUE;
231 
     END EQUAL;
232 
 
233 
BEGIN
234 
     TEST ("C34005S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
235 
                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
236 
                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
237 
                      "TYPE IS A LIMITED TYPE.    THIS TEST IS PART " &
238 
                      "1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
239 
                      "SECOND PART IS IN TEST C34005V");
240 
 
241 
     ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
242 
     ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
243 
     ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
244 
     ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
245 
     ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
246 
     ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
247 
 
248 
     ASSIGN (W (4, 6), CREATE (1));
249 
     ASSIGN (W (4, 7), CREATE (2));
250 
     ASSIGN (W (4, 8), CREATE (3));
251 
     ASSIGN (W (5, 6), CREATE (4));
252 
     ASSIGN (W (5, 7), CREATE (5));
253 
     ASSIGN (W (5, 8), CREATE (6));
254 
 
255 
     ASSIGN (C, CREATE (2));
256 
 
257 
     ASSIGN (U (8, 2), CREATE (1));
258 
     ASSIGN (U (8, 3), CREATE (2));
259 
     ASSIGN (U (8, 4), CREATE (3));
260 
     ASSIGN (U (9, 2), CREATE (4));
261 
     ASSIGN (U (9, 3), CREATE (5));
262 
     ASSIGN (U (9, 4), CREATE (6));
263 
 
264 
     IF NOT EQUAL (X (IDENT_INT (4), IDENT_INT (6)), C1) OR
265 
        NOT EQUAL (CREATE (6, 9, 2, 3, C4, X) (9, 3), C11) THEN
266 
          FAILED ("INCORRECT INDEX (VALUE)");
267 
     END IF;
268 
 
269 
     B := FALSE;
270 
     A (X'ADDRESS);
271 
     IF NOT B THEN
272 
          FAILED ("INCORRECT 'ADDRESS");
273 
     END IF;
274 
 
275 
     IF T'FIRST /= 4 THEN
276 
          FAILED ("INCORRECT TYPE'FIRST");
277 
     END IF;
278 
 
279 
     IF X'FIRST /= 4 THEN
280 
          FAILED ("INCORRECT OBJECT'FIRST");
281 
     END IF;
282 
 
283 
     IF V'FIRST /= 4 THEN
284 
          FAILED ("INCORRECT VALUE'FIRST");
285 
     END IF;
286 
 
287 
     IF T'FIRST (N) /= 6 THEN
288 
          FAILED ("INCORRECT TYPE'FIRST (N)");
289 
     END IF;
290 
 
291 
     IF X'FIRST (N) /= 6 THEN
292 
          FAILED ("INCORRECT OBJECT'FIRST (N)");
293 
     END IF;
294 
 
295 
     IF V'FIRST (N) /= 6 THEN
296 
          FAILED ("INCORRECT VALUE'FIRST (N)");
297 
     END IF;
298 
 
299 
     IF T'LAST /= 5 THEN
300 
          FAILED ("INCORRECT TYPE'LAST");
301 
     END IF;
302 
 
303 
     IF X'LAST /= 5 THEN
304 
          FAILED ("INCORRECT OBJECT'LAST");
305 
     END IF;
306 
 
307 
     IF V'LAST /= 5 THEN
308 
          FAILED ("INCORRECT VALUE'LAST");
309 
     END IF;
310 
 
311 
     IF T'LAST (N) /= 8 THEN
312 
          FAILED ("INCORRECT TYPE'LAST (N)");
313 
     END IF;
314 
 
315 
     IF X'LAST (N) /= 8 THEN
316 
          FAILED ("INCORRECT OBJECT'LAST (N)");
317 
     END IF;
318 
 
319 
     IF V'LAST (N) /= 8 THEN
320 
          FAILED ("INCORRECT VALUE'LAST (N)");
321 
     END IF;
322 
 
323 
     IF T'LENGTH /= 2 THEN
324 
          FAILED ("INCORRECT TYPE'LENGTH");
325 
     END IF;
326 
 
327 
     IF X'LENGTH /= 2 THEN
328 
          FAILED ("INCORRECT OBJECT'LENGTH");
329 
     END IF;
330 
 
331 
     IF V'LENGTH /= 2 THEN
332 
          FAILED ("INCORRECT VALUE'LENGTH");
333 
     END IF;
334 
 
335 
     IF T'LENGTH (N) /= 3 THEN
336 
          FAILED ("INCORRECT TYPE'LENGTH (N)");
337 
     END IF;
338 
 
339 
     IF X'LENGTH (N) /= 3 THEN
340 
          FAILED ("INCORRECT OBJECT'LENGTH (N)");
341 
     END IF;
342 
 
343 
     IF V'LENGTH (N) /= 3 THEN
344 
          FAILED ("INCORRECT VALUE'LENGTH (N)");
345 
     END IF;
346 
 
347 
     DECLARE
348 
          Y : PARENT (T'RANGE, 1 .. 3);
349 
     BEGIN
350 
          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
351 
               FAILED ("INCORRECT TYPE'RANGE");
352 
          END IF;
353 
     END;
354 
 
355 
     DECLARE
356 
          Y : PARENT (X'RANGE, 1 .. 3);
357 
     BEGIN
358 
          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
359 
               FAILED ("INCORRECT OBJECT'RANGE");
360 
          END IF;
361 
     END;
362 
 
363 
     DECLARE
364 
          Y : PARENT (V'RANGE, 1 .. 3);
365 
     BEGIN
366 
          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
367 
               FAILED ("INCORRECT VALUE'RANGE");
368 
          END IF;
369 
     END;
370 
 
371 
     DECLARE
372 
          Y : PARENT (1 .. 2, T'RANGE (N));
373 
     BEGIN
374 
          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
375 
               FAILED ("INCORRECT TYPE'RANGE (N)");
376 
          END IF;
377 
     END;
378 
 
379 
     DECLARE
380 
          Y : PARENT (1 .. 2, X'RANGE (N));
381 
     BEGIN
382 
          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
383 
               FAILED ("INCORRECT OBJECT'RANGE (N)");
384 
          END IF;
385 
     END;
386 
 
387 
     DECLARE
388 
          Y : PARENT (1 .. 2, V'RANGE (N));
389 
     BEGIN
390 
          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
391 
               FAILED ("INCORRECT VALUE'RANGE (N)");
392 
          END IF;
393 
     END;
394 
 
395 
     IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
396 
          FAILED ("INCORRECT TYPE'SIZE");
397 
     END IF;
398 
 
399 
     IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
400 
          FAILED ("INCORRECT OBJECT'SIZE");
401 
     END IF;
402 
 
403 
     RESULT;
404 
END C34005S;

powered by: WebSVN 2.1.0

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