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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C47009B.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 
--     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN ACCESS
27 
--     TYPE, CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE VALUE
28 
--     OF THE OPERAND IS NULL.
29 
 
30 
-- HISTORY:
31 
--     RJW 07/23/86  CREATED ORIGINAL TEST.
32 
--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
33 
--                   CONSTRAINTS OF B SUBTYPES TO VALUES WHICH ARE
34 
--                   CLOSER TO THE VALUES OF THE A SUBTYPES.  INDENTED
35 
--                   THE EXCEPTION STATEMENTS IN SUBTEST 11.
36 
 
37 
WITH REPORT; USE REPORT;
38 
PROCEDURE C47009B IS
39 
 
40 
BEGIN
41 
 
42 
     TEST( "C47009B", "WHEN THE TYPE MARK IN A QUALIFIED " &
43 
                      "EXPRESSION DENOTES AN ACCESS TYPE, " &
44 
                      "CHECK THAT CONSTRAINT_ERROR IS NOT " &
45 
                      "RAISED WHEN THE VALUE OF THE OPERAND IS NULL" );
46 
 
47 
     DECLARE
48 
 
49 
          TYPE ACC1 IS ACCESS BOOLEAN;
50 
          A : ACC1;
51 
 
52 
     BEGIN
53 
          A := ACC1'(NULL);
54 
     EXCEPTION
55 
          WHEN CONSTRAINT_ERROR =>
56 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC1" );
57 
          WHEN OTHERS =>
58 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC1" );
59 
     END;
60 
 
61 
     DECLARE
62 
 
63 
          TYPE ACC2 IS ACCESS INTEGER;
64 
          A : ACC2;
65 
 
66 
     BEGIN
67 
          A := ACC2'(NULL);
68 
     EXCEPTION
69 
          WHEN CONSTRAINT_ERROR =>
70 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC2" );
71 
          WHEN OTHERS =>
72 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC2" );
73 
     END;
74 
 
75 
     DECLARE
76 
 
77 
          TYPE CHAR IS ('A', 'B');
78 
          TYPE ACC3 IS ACCESS CHAR;
79 
          A : ACC3;
80 
 
81 
     BEGIN
82 
          A := ACC3'(NULL);
83 
     EXCEPTION
84 
          WHEN CONSTRAINT_ERROR =>
85 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC3" );
86 
          WHEN OTHERS =>
87 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC3" );
88 
     END;
89 
 
90 
     DECLARE
91 
 
92 
          TYPE FLOAT1 IS DIGITS 5 RANGE -1.0 .. 1.0;
93 
          TYPE ACC4 IS ACCESS FLOAT1;
94 
          A : ACC4;
95 
 
96 
     BEGIN
97 
          A := ACC4'(NULL);
98 
     EXCEPTION
99 
          WHEN CONSTRAINT_ERROR =>
100 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC4" );
101 
          WHEN OTHERS =>
102 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC4" );
103 
     END;
104 
 
105 
     DECLARE
106 
 
107 
          TYPE FIXED IS DELTA 0.5 RANGE -1.0 .. 1.0;
108 
          TYPE ACC5 IS ACCESS FIXED;
109 
          A : ACC5;
110 
 
111 
     BEGIN
112 
          A := ACC5'(NULL);
113 
     EXCEPTION
114 
          WHEN CONSTRAINT_ERROR =>
115 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC5" );
116 
          WHEN OTHERS =>
117 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC5" );
118 
     END;
119 
 
120 
     DECLARE
121 
 
122 
          TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
123 
          TYPE ACC6 IS ACCESS ARR;
124 
          SUBTYPE ACC6A IS ACC6 (IDENT_INT (1) .. IDENT_INT (5));
125 
          SUBTYPE ACC6B IS ACC6 (IDENT_INT (2) .. IDENT_INT (10));
126 
          A : ACC6A;
127 
          B : ACC6B;
128 
 
129 
     BEGIN
130 
          A := ACC6A'(B);
131 
     EXCEPTION
132 
          WHEN CONSTRAINT_ERROR =>
133 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
134 
                        "TYPE ACC6" );
135 
          WHEN OTHERS =>
136 
               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
137 
                        "TYPE ACC6" );
138 
     END;
139 
 
140 
     DECLARE
141 
 
142 
          TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
143 
               OF INTEGER;
144 
          TYPE ACC7 IS ACCESS ARR;
145 
          SUBTYPE ACC7A IS ACC7 (IDENT_INT (1) .. IDENT_INT (5),
146 
                                 IDENT_INT (1) .. IDENT_INT (1));
147 
          SUBTYPE ACC7B IS ACC7 (IDENT_INT (1) .. IDENT_INT (15),
148 
                                 IDENT_INT (1) .. IDENT_INT (10));
149 
          A : ACC7A;
150 
          B : ACC7B;
151 
 
152 
     BEGIN
153 
          A := ACC7A'(B);
154 
     EXCEPTION
155 
          WHEN CONSTRAINT_ERROR =>
156 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
157 
                        "TYPE ACC7" );
158 
          WHEN OTHERS =>
159 
               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
160 
                        "TYPE ACC7" );
161 
     END;
162 
 
163 
     DECLARE
164 
 
165 
          TYPE REC (D : INTEGER) IS
166 
               RECORD
167 
                    NULL;
168 
               END RECORD;
169 
 
170 
          TYPE ACC8 IS ACCESS REC;
171 
          SUBTYPE ACC8A IS ACC8 (IDENT_INT (5));
172 
          SUBTYPE ACC8B IS ACC8 (IDENT_INT (6));
173 
          A : ACC8A;
174 
          B : ACC8B;
175 
 
176 
     BEGIN
177 
          A := ACC8A'(B);
178 
     EXCEPTION
179 
          WHEN CONSTRAINT_ERROR =>
180 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
181 
                        "TYPE ACC8" );
182 
          WHEN OTHERS =>
183 
               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
184 
                        "TYPE ACC8" );
185 
     END;
186 
 
187 
     DECLARE
188 
 
189 
          TYPE REC (D1,D2 : INTEGER) IS
190 
               RECORD
191 
                    NULL;
192 
               END RECORD;
193 
 
194 
          TYPE ACC9 IS ACCESS REC;
195 
          SUBTYPE ACC9A IS ACC9 (IDENT_INT (4), IDENT_INT (5));
196 
          SUBTYPE ACC9B IS ACC9 (IDENT_INT (5), IDENT_INT (4));
197 
          A : ACC9A;
198 
          B : ACC9B;
199 
 
200 
     BEGIN
201 
          A := ACC9A'(B);
202 
     EXCEPTION
203 
          WHEN CONSTRAINT_ERROR =>
204 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
205 
                        "TYPE ACC9" );
206 
          WHEN OTHERS =>
207 
               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
208 
                        "TYPE ACC9" );
209 
     END;
210 
 
211 
     DECLARE
212 
 
213 
          PACKAGE PKG IS
214 
               TYPE REC (D : INTEGER) IS PRIVATE;
215 
 
216 
          PRIVATE
217 
               TYPE REC (D : INTEGER) IS
218 
                    RECORD
219 
                         NULL;
220 
                    END RECORD;
221 
 
222 
          END PKG;
223 
 
224 
          USE PKG;
225 
 
226 
          TYPE ACC10 IS ACCESS REC;
227 
          SUBTYPE ACC10A IS ACC10 (IDENT_INT (10));
228 
          SUBTYPE ACC10B IS ACC10 (IDENT_INT (9));
229 
          A : ACC10A;
230 
          B : ACC10B;
231 
 
232 
     BEGIN
233 
          A := ACC10A'(B);
234 
     EXCEPTION
235 
          WHEN CONSTRAINT_ERROR =>
236 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
237 
                        "TYPE ACC10" );
238 
          WHEN OTHERS =>
239 
               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
240 
                        "TYPE ACC10" );
241 
     END;
242 
 
243 
     DECLARE
244 
 
245 
          PACKAGE PKG1 IS
246 
               TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
247 
 
248 
          PRIVATE
249 
               TYPE REC (D : INTEGER) IS
250 
                    RECORD
251 
                         NULL;
252 
                    END RECORD;
253 
          END PKG1;
254 
 
255 
          PACKAGE PKG2 IS END PKG2;
256 
 
257 
          PACKAGE BODY PKG2 IS
258 
               USE PKG1;
259 
 
260 
               TYPE ACC11 IS ACCESS REC;
261 
               SUBTYPE ACC11A IS ACC11 (IDENT_INT (11));
262 
               SUBTYPE ACC11B IS ACC11 (IDENT_INT (12));
263 
               A : ACC11A;
264 
               B : ACC11B;
265 
 
266 
          BEGIN
267 
               A := ACC11A'(B);
268 
          EXCEPTION
269 
               WHEN CONSTRAINT_ERROR =>
270 
                    FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF" &
271 
                             " TYPE ACC11" );
272 
               WHEN OTHERS =>
273 
                    FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
274 
                             "TYPE ACC11" );
275 
          END PKG2;
276 
 
277 
     BEGIN
278 
          NULL;
279 
     END;
280 
 
281 
     RESULT;
282 
END C47009B;

powered by: WebSVN 2.1.0

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