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/] [c3/] [c37213d.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 
-- C37213D.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 
--        AN INDEX CONSTRAINT
27 
-- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
28 
-- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
29 
-- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
30 
--
31 
--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
32 
--      DECLARATION.
33 
 
34 
-- JBG 10/17/86
35 
 
36 
WITH REPORT; USE REPORT;
37 
PROCEDURE C37213D IS
38 
 
39 
     SUBTYPE SM IS INTEGER RANGE 1..10;
40 
 
41 
     TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
42 
 
43 
     F1_CONS : INTEGER := 2;
44 
 
45 
     FUNCTION CHK (
46 
          CONS    : INTEGER;
47 
          VALUE   : INTEGER;
48 
          MESSAGE : STRING) RETURN BOOLEAN IS
49 
     BEGIN
50 
          IF CONS /= VALUE THEN
51 
               FAILED (MESSAGE & ": CONS IS " &
52 
                       INTEGER'IMAGE(CONS));
53 
          END IF;
54 
          RETURN TRUE;
55 
     END CHK;
56 
 
57 
     FUNCTION F1 RETURN INTEGER IS
58 
     BEGIN
59 
          F1_CONS := F1_CONS - IDENT_INT(1);
60 
          RETURN F1_CONS;
61 
     END F1;
62 
 
63 
BEGIN
64 
     TEST ("C37213D", "CHECK EVALUATION OF INDEX BOUNDS " &
65 
                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
66 
                      "AND DISCRIMINANTS HAVE DEFAULTS");
67 
 
68 
-- CASE B
69 
 
70 
     DECLARE
71 
          TYPE CONS (D3 : INTEGER := 1) IS
72 
               RECORD
73 
                    C1 : MY_ARR (F1..D3);    -- F1 EVALUATED.
74 
               END RECORD;
75 
          CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
76 
          X : CONS;             -- F1 NOT EVALUATED AGAIN
77 
          Y : CONS;             -- F1 NOT EVALUATED AGAIN
78 
          CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
79 
     BEGIN
80 
          IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
81 
               FAILED ("INDEX BOUNDS NOT CORRECT");
82 
          END IF;
83 
     END;
84 
 
85 
     F1_CONS := 12;
86 
 
87 
     DECLARE
88 
          TYPE CONS (D3 : INTEGER := 1) IS
89 
               RECORD
90 
                    C1 : MY_ARR(D3..F1);
91 
               END RECORD;
92 
     BEGIN
93 
          BEGIN
94 
               DECLARE
95 
                    X : CONS;
96 
               BEGIN
97 
                    FAILED ("INDEX CHECK NOT PERFORMED - 1");
98 
                    IF X /= (1, (1, 1)) THEN
99 
                         COMMENT ("SHOULDN'T GET HERE");
100 
                    END IF;
101 
               END;
102 
          EXCEPTION
103 
               WHEN CONSTRAINT_ERROR =>
104 
                    NULL;
105 
               WHEN OTHERS =>
106 
                    FAILED ("UNEXPECTED EXCEPTION - 1");
107 
          END;
108 
 
109 
          BEGIN
110 
               DECLARE
111 
                    TYPE ACC_CONS IS ACCESS CONS;
112 
                    X : ACC_CONS;
113 
               BEGIN
114 
                    X := NEW CONS;
115 
                    FAILED ("INDEX CHECK NOT PERFORMED - 2");
116 
                    BEGIN
117 
                         IF X.ALL /= (1, (1 => 1)) THEN
118 
                              COMMENT ("IRRELEVANT");
119 
                         END IF;
120 
                    END;
121 
               EXCEPTION
122 
                    WHEN CONSTRAINT_ERROR =>
123 
                         NULL;
124 
                    WHEN OTHERS =>
125 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
126 
               END;
127 
          EXCEPTION
128 
               WHEN OTHERS =>
129 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
130 
          END;
131 
 
132 
          BEGIN
133 
               DECLARE
134 
                    SUBTYPE SCONS IS CONS;
135 
               BEGIN
136 
                    DECLARE
137 
                         X : SCONS;
138 
                    BEGIN
139 
                         FAILED ("INDEX CHECK NOT " &
140 
                                 "PERFORMED - 3");
141 
                         IF X /= (1, (1 => 1)) THEN
142 
                              COMMENT ("IRRELEVANT");
143 
                         END IF;
144 
                    END;
145 
               EXCEPTION
146 
                    WHEN CONSTRAINT_ERROR =>
147 
                         NULL;
148 
                    WHEN OTHERS =>
149 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
150 
               END;
151 
          EXCEPTION
152 
               WHEN OTHERS =>
153 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
154 
          END;
155 
 
156 
          BEGIN
157 
               DECLARE
158 
                    TYPE ARR IS ARRAY (1..5) OF CONS;
159 
               BEGIN
160 
                    DECLARE
161 
                         X : ARR;
162 
                    BEGIN
163 
                         FAILED ("INDEX CHECK NOT " &
164 
                                 "PERFORMED - 4");
165 
                         IF X /= (1..5 => (1, (1 => 1))) THEN
166 
                              COMMENT ("IRRELEVANT");
167 
                         END IF;
168 
                    END;
169 
               EXCEPTION
170 
                    WHEN CONSTRAINT_ERROR =>
171 
                         NULL;
172 
                    WHEN OTHERS =>
173 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
174 
               END;
175 
          EXCEPTION
176 
               WHEN OTHERS =>
177 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
178 
          END;
179 
 
180 
          BEGIN
181 
               DECLARE
182 
                    TYPE NREC IS
183 
                         RECORD
184 
                              C1 : CONS;
185 
                         END RECORD;
186 
               BEGIN
187 
                    DECLARE
188 
                         X : NREC;
189 
                    BEGIN
190 
                         FAILED ("INDEX CHECK NOT " &
191 
                                 "PERFORMED - 5");
192 
                         IF X /= (C1 => (1, (1 => 1))) THEN
193 
                              COMMENT ("IRRELEVANT");
194 
                         END IF;
195 
                    END;
196 
               EXCEPTION
197 
                    WHEN CONSTRAINT_ERROR =>
198 
                         NULL;
199 
                    WHEN OTHERS =>
200 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
201 
               END;
202 
          EXCEPTION
203 
               WHEN OTHERS =>
204 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
205 
          END;
206 
 
207 
          BEGIN
208 
               DECLARE
209 
                    TYPE DREC IS NEW CONS;
210 
               BEGIN
211 
                    DECLARE
212 
                         X : DREC;
213 
                    BEGIN
214 
                         FAILED ("INDEX CHECK NOT " &
215 
                                 "PERFORMED - 6");
216 
                         IF X /= (1, (1 => 1)) THEN
217 
                              COMMENT ("IRRELEVANT");
218 
                         END IF;
219 
                    END;
220 
               EXCEPTION
221 
                    WHEN CONSTRAINT_ERROR =>
222 
                         NULL;
223 
                    WHEN OTHERS =>
224 
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
225 
               END;
226 
          EXCEPTION
227 
               WHEN OTHERS =>
228 
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
229 
          END;
230 
 
231 
     END;
232 
 
233 
     RESULT;
234 
 
235 
EXCEPTION
236 
     WHEN OTHERS =>
237 
          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
238 
          RESULT;
239 
 
240 
END C37213D;

powered by: WebSVN 2.1.0

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