|
111
|
1 -- 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;
|
