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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C34005O.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 
--     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE
27 
--     IS A NON-LIMITED TYPE:
28 
--     CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
29 
--     THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
30 
--     CONSTRAINED.
31 
--     CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
32 
--     IMPOSED ON THE DERIVED SUBTYPE.
33 
 
34 
-- HISTORY:
35 
--     JRK 9/17/86  CREATED ORIGINAL TEST.
36 
 
37 
WITH REPORT; USE REPORT;
38 
 
39 
PROCEDURE C34005O IS
40 
 
41 
     SUBTYPE COMPONENT IS INTEGER;
42 
 
43 
     PACKAGE PKG IS
44 
 
45 
          FIRST : CONSTANT := 0;
46 
          LAST  : CONSTANT := 10;
47 
 
48 
          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
49 
 
50 
          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
51 
                               COMPONENT;
52 
 
53 
          FUNCTION CREATE ( F1, L1 : INDEX;
54 
                            F2, L2 : INDEX;
55 
                            C      : COMPONENT;
56 
                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
57 
                          ) RETURN PARENT;
58 
 
59 
     END PKG;
60 
 
61 
     USE PKG;
62 
 
63 
     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
64 
                           IDENT_INT (6) .. IDENT_INT (8));
65 
 
66 
     SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
67 
 
68 
     TYPE S IS NEW SUBPARENT;
69 
 
70 
     X : T := (OTHERS => (OTHERS => 2));
71 
     Y : S := (OTHERS => (OTHERS => 2));
72 
 
73 
     PACKAGE BODY PKG IS
74 
 
75 
          FUNCTION CREATE
76 
             ( F1, L1 : INDEX;
77 
               F2, L2 : INDEX;
78 
               C      : COMPONENT;
79 
               DUMMY  : PARENT
80 
             ) RETURN PARENT
81 
          IS
82 
               A : PARENT (F1 .. L1, F2 .. L2);
83 
               B : COMPONENT := C;
84 
          BEGIN
85 
               FOR I IN F1 .. L1 LOOP
86 
                    FOR J IN F2 .. L2 LOOP
87 
                         A (I, J) := B;
88 
                         B := B + 1;
89 
                    END LOOP;
90 
               END LOOP;
91 
               RETURN A;
92 
          END CREATE;
93 
 
94 
     END PKG;
95 
 
96 
BEGIN
97 
     TEST ("C34005O", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
98 
                      "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
99 
                      "WHEN THE DERIVED TYPE DEFINITION IS " &
100 
                      "CONSTRAINED.  ALSO CHECK THAT ANY CONSTRAINT " &
101 
                      "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
102 
                      "ON THE DERIVED SUBTYPE.  CHECK FOR DERIVED " &
103 
                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
104 
                      "TYPE IS A NON-LIMITED TYPE");
105 
 
106 
     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
107 
 
108 
     BEGIN
109 
          IF CREATE (6, 9, 2, 3, 1, X) /=
110 
             ((1, 2), (3, 4), (5, 6), (7, 8)) OR
111 
             CREATE (6, 9, 2, 3, 1, Y) /=
112 
             ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
113 
               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
114 
                       "SUBTYPE");
115 
          END IF;
116 
     EXCEPTION
117 
          WHEN CONSTRAINT_ERROR =>
118 
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
119 
          WHEN OTHERS =>
120 
               FAILED ("CALL TO CREATE RAISED EXCEPTION");
121 
     END;
122 
 
123 
     IF ((1, 2), (3, 4), (5, 6), (7, 8)) IN T OR
124 
        ((1, 2), (3, 4), (5, 6), (7, 8)) IN S THEN
125 
          FAILED ("INCORRECT ""IN""");
126 
     END IF;
127 
 
128 
     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
129 
 
130 
     IF T'FIRST /= 4 OR T'LAST /= 5 OR
131 
        S'FIRST /= 4 OR S'LAST /= 5 OR
132 
        T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
133 
        S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
134 
          FAILED ("INCORRECT 'FIRST OR 'LAST");
135 
     END IF;
136 
 
137 
     BEGIN
138 
          X := ((1, 2, 3), (4, 5, 6));
139 
          Y := ((1, 2, 3), (4, 5, 6));
140 
          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
141 
               FAILED ("INCORRECT CONVERSION TO PARENT");
142 
          END IF;
143 
     EXCEPTION
144 
          WHEN OTHERS =>
145 
               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
146 
     END;
147 
 
148 
     BEGIN
149 
          X := (4 => (6 .. 8 => 0));
150 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
151 
                  "X := (4 => (6 .. 8 => 0))");
152 
          IF X = (4 => (6 .. 8 => 0)) THEN  -- USE X.
153 
               COMMENT ("X ALTERED -- " &
154 
                        "X := (4 => (6 .. 8 => 0))");
155 
          END IF;
156 
     EXCEPTION
157 
          WHEN CONSTRAINT_ERROR =>
158 
               NULL;
159 
          WHEN OTHERS =>
160 
               FAILED ("WRONG EXCEPTION RAISED -- " &
161 
                       "X := (4 => (6 .. 8 => 0))");
162 
     END;
163 
 
164 
     BEGIN
165 
          X := (4 .. 6 => (6 .. 8 => 0));
166 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
167 
                  "X := (4 .. 6 => (6 .. 8 => 0))");
168 
          IF X = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE X.
169 
               COMMENT ("X ALTERED -- " &
170 
                        "X := (4 .. 6 => (6 .. 8 => 0))");
171 
          END IF;
172 
     EXCEPTION
173 
          WHEN CONSTRAINT_ERROR =>
174 
               NULL;
175 
          WHEN OTHERS =>
176 
               FAILED ("WRONG EXCEPTION RAISED -- " &
177 
                       "X := (4 .. 6 => (6 .. 8 => 0))");
178 
     END;
179 
 
180 
     BEGIN
181 
          X := (4 .. 5 => (6 .. 7 => 0));
182 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
183 
                  "X := (4 .. 5 => (6 .. 7 => 0))");
184 
          IF X = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE X.
185 
               COMMENT ("X ALTERED -- " &
186 
                        "X := (4 .. 5 => (6 .. 7 => 0))");
187 
          END IF;
188 
     EXCEPTION
189 
          WHEN CONSTRAINT_ERROR =>
190 
               NULL;
191 
          WHEN OTHERS =>
192 
               FAILED ("WRONG EXCEPTION RAISED -- " &
193 
                       "X := (4 .. 5 => (6 .. 7 => 0))");
194 
     END;
195 
 
196 
     BEGIN
197 
          X := (4 .. 5 => (6 .. 9 => 0));
198 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
199 
                  "X := (4 .. 5 => (6 .. 9 => 0))");
200 
          IF X = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE X.
201 
               COMMENT ("X ALTERED -- " &
202 
                        "X := (4 .. 5 => (6 .. 9 => 0))");
203 
          END IF;
204 
     EXCEPTION
205 
          WHEN CONSTRAINT_ERROR =>
206 
               NULL;
207 
          WHEN OTHERS =>
208 
               FAILED ("WRONG EXCEPTION RAISED -- " &
209 
                       "X := (4 .. 5 => (6 .. 9 => 0))");
210 
     END;
211 
 
212 
     BEGIN
213 
          Y := (4 => (6 .. 8 => 0));
214 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
215 
                  "Y := (4 => (6 .. 8 => 0))");
216 
          IF Y = (4 => (6 .. 8 => 0)) THEN  -- USE Y.
217 
               COMMENT ("Y ALTERED -- " &
218 
                        "Y := (4 => (6 .. 8 => 0))");
219 
          END IF;
220 
     EXCEPTION
221 
          WHEN CONSTRAINT_ERROR =>
222 
               NULL;
223 
          WHEN OTHERS =>
224 
               FAILED ("WRONG EXCEPTION RAISED -- " &
225 
                       "Y := (4 => (6 .. 8 => 0))");
226 
     END;
227 
 
228 
     BEGIN
229 
          Y := (4 .. 6 => (6 .. 8 => 0));
230 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
231 
                  "Y := (4 .. 6 => (6 .. 8 => 0))");
232 
          IF Y = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE Y.
233 
               COMMENT ("Y ALTERED -- " &
234 
                        "Y := (4 .. 6 => (6 .. 8 => 0))");
235 
          END IF;
236 
     EXCEPTION
237 
          WHEN CONSTRAINT_ERROR =>
238 
               NULL;
239 
          WHEN OTHERS =>
240 
               FAILED ("WRONG EXCEPTION RAISED -- " &
241 
                       "Y := (4 .. 6 => (6 .. 8 => 0))");
242 
     END;
243 
 
244 
     BEGIN
245 
          Y := (4 .. 5 => (6 .. 7 => 0));
246 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
247 
                  "Y := (4 .. 5 => (6 .. 7 => 0))");
248 
          IF Y = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE Y.
249 
               COMMENT ("Y ALTERED -- " &
250 
                        "Y := (4 .. 5 => (6 .. 7 => 0))");
251 
          END IF;
252 
     EXCEPTION
253 
          WHEN CONSTRAINT_ERROR =>
254 
               NULL;
255 
          WHEN OTHERS =>
256 
               FAILED ("WRONG EXCEPTION RAISED -- " &
257 
                       "Y := (4 .. 5 => (6 .. 7 => 0))");
258 
     END;
259 
 
260 
     BEGIN
261 
          Y := (4 .. 5 => (6 .. 9 => 0));
262 
          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
263 
                  "Y := (4 .. 5 => (6 .. 9 => 0))");
264 
          IF Y = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE Y.
265 
               COMMENT ("Y ALTERED -- " &
266 
                        "Y := (4 .. 5 => (6 .. 9 => 0))");
267 
          END IF;
268 
     EXCEPTION
269 
          WHEN CONSTRAINT_ERROR =>
270 
               NULL;
271 
          WHEN OTHERS =>
272 
               FAILED ("WRONG EXCEPTION RAISED -- " &
273 
                       "Y := (4 .. 5 => (6 .. 9 => 0))");
274 
     END;
275 
 
276 
     RESULT;
277 
END C34005O;

powered by: WebSVN 2.1.0

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