|
111
|
1 -- C371002.A
|
|
|
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 --
|
|
|
26 -- OBJECTIVE:
|
|
|
27 -- Check that if a discriminant constraint depends on a discriminant,
|
|
|
28 -- the evaluation of the expressions in the constraint is deferred until
|
|
|
29 -- an object of the subtype is created. Check for cases of records.
|
|
|
30 --
|
|
|
31 -- TEST DESCRIPTION:
|
|
|
32 -- This transition test defines record types with discriminant components
|
|
|
33 -- which depend on the discriminants. The discriminants are calculated
|
|
|
34 -- by function calls. The test verifies that Constraint_Error is raised
|
|
|
35 -- during the object creations when values of discriminants are
|
|
|
36 -- incompatible with the subtypes.
|
|
|
37 --
|
|
|
38 -- Inspired by C37213A.ADA, C37213C.ADA, C37215A.ADA and C37215C.ADA.
|
|
|
39 --
|
|
|
40 --
|
|
|
41 -- CHANGE HISTORY:
|
|
|
42 -- 05 Apr 96 SAIC Initial version for ACVC 2.1.
|
|
|
43 --
|
|
|
44 --!
|
|
|
45
|
|
|
46 with Report;
|
|
|
47
|
|
|
48 procedure C371002 is
|
|
|
49
|
|
|
50 subtype Small_Int is Integer range 1..10;
|
|
|
51
|
|
|
52 type Rec_W_Disc (Disc1, Disc2 : Small_Int) is
|
|
|
53 record
|
|
|
54 Str1 : String (1 .. Disc1) := (others => '*');
|
|
|
55 Str2 : String (1 .. Disc2) := (others => '*');
|
|
|
56 end record;
|
|
|
57
|
|
|
58 type My_Array is array (Small_Int range <>) of Integer;
|
|
|
59
|
|
|
60 Func1_Cons : Integer := 0;
|
|
|
61
|
|
|
62 ---------------------------------------------------------
|
|
|
63 function Chk (Cons : Integer;
|
|
|
64 Value : Integer;
|
|
|
65 Message : String) return Boolean is
|
|
|
66 begin
|
|
|
67 if Cons /= Value then
|
|
|
68 Report.Failed (Message & ": Func1_Cons is " &
|
|
|
69 Integer'Image(Func1_Cons));
|
|
|
70 end if;
|
|
|
71 return True;
|
|
|
72 end Chk;
|
|
|
73
|
|
|
74 ---------------------------------------------------------
|
|
|
75 function Func1 return Integer is
|
|
|
76 begin
|
|
|
77 Func1_Cons := Func1_Cons + Report.Ident_Int(1);
|
|
|
78 return Func1_Cons;
|
|
|
79 end Func1;
|
|
|
80
|
|
|
81 begin
|
|
|
82 Report.Test ("C371002", "Check that if a discriminant constraint " &
|
|
|
83 "depends on a discriminant, the evaluation of the " &
|
|
|
84 "expressions in the constraint is deferred until " &
|
|
|
85 "object declarations");
|
|
|
86
|
|
|
87 ---------------------------------------------------------
|
|
|
88 declare
|
|
|
89 type Rec1 (D3 : Integer) is
|
|
|
90 record
|
|
|
91 C1 : Rec_W_Disc (D3, Func1); -- Func1 evaluated, value 1.
|
|
|
92 end record;
|
|
|
93
|
|
|
94 Chk1 : Boolean := Chk (Func1_Cons, 1,
|
|
|
95 "Func1 not evaluated for Rec1");
|
|
|
96
|
|
|
97 Obj1 : Rec1 (1); -- Func1 not evaluated again.
|
|
|
98 Obj2 : Rec1 (2); -- Func1 not evaluated again.
|
|
|
99
|
|
|
100 Chk2 : Boolean := Chk (Func1_Cons, 1,
|
|
|
101 "Func1 evaluated too many times");
|
|
|
102 begin
|
|
|
103 if Obj1 /= (D3 => 1,
|
|
|
104 C1 => (Disc1 => 1,
|
|
|
105 Disc2 => 1,
|
|
|
106 Str1 => (others => '*'),
|
|
|
107 Str2 => (others => '*'))) or
|
|
|
108 Obj2 /= (D3 => 2,
|
|
|
109 C1 => (Disc1 => 2,
|
|
|
110 Disc2 => 1,
|
|
|
111 Str1 => (others => '*'),
|
|
|
112 Str2 => (others => '*'))) then
|
|
|
113 Report.Failed ("Obj1 & Obj2 - Discriminant values not correct");
|
|
|
114 end if;
|
|
|
115 end;
|
|
|
116
|
|
|
117 ---------------------------------------------------------
|
|
|
118 Func1_Cons := -11;
|
|
|
119
|
|
|
120 declare
|
|
|
121 type Rec_Of_Rec_01 (D3 : Integer) is
|
|
|
122 record
|
|
|
123 C1 : Rec_W_Disc (D3, Func1); -- Func1 evaluated, value -10.
|
|
|
124 end record; -- Constraint_Error not raised.
|
|
|
125
|
|
|
126 type Rec_Of_MyArr_01 (D3 : Integer) is
|
|
|
127 record
|
|
|
128 C1 : My_Array (Func1 .. D3); -- Func1 evaluated, value -9.
|
|
|
129 end record; -- Constraint_Error not raised.
|
|
|
130
|
|
|
131 type Rec_Of_Rec_02 (D3 : Integer) is
|
|
|
132 record
|
|
|
133 C1 : Rec_W_Disc (D3, 1);
|
|
|
134 end record;
|
|
|
135
|
|
|
136 type Rec_Of_MyArr_02 (D3 : Integer) is
|
|
|
137 record
|
|
|
138 C1 : My_Array (D3 .. 1);
|
|
|
139 end record;
|
|
|
140
|
|
|
141 begin
|
|
|
142
|
|
|
143 ---------------------------------------------------------
|
|
|
144 begin
|
|
|
145 declare
|
|
|
146 Obj3 : Rec_Of_Rec_01(1); -- Constraint_Error raised.
|
|
|
147 begin
|
|
|
148 Report.Failed ("Obj3 - Constraint_Error should be raised");
|
|
|
149 if Obj3 /= (1, (1, 1, others => (others => '*'))) then
|
|
|
150 Report.Comment ("Obj3 - Shouldn't get here");
|
|
|
151 end if;
|
|
|
152 end;
|
|
|
153
|
|
|
154 exception
|
|
|
155 when Constraint_Error => -- Exception expected.
|
|
|
156 null;
|
|
|
157 when others =>
|
|
|
158 Report.Failed ("Obj3 - others exception raised");
|
|
|
159 end;
|
|
|
160
|
|
|
161 ---------------------------------------------------------
|
|
|
162 begin
|
|
|
163 declare
|
|
|
164 subtype Subtype_Rec is Rec_Of_Rec_01(1);
|
|
|
165 -- No Constraint_Error raised.
|
|
|
166 begin
|
|
|
167 declare
|
|
|
168 Obj4 : Subtype_Rec; -- Constraint_Error raised.
|
|
|
169 begin
|
|
|
170 Report.Failed ("Obj4 - Constraint_Error should be raised");
|
|
|
171 if Obj4 /= (D3 => 1,
|
|
|
172 C1 => (Disc1 => 1,
|
|
|
173 Disc2 => 1,
|
|
|
174 Str1 => (others => '*'),
|
|
|
175 Str2 => (others => '*'))) then
|
|
|
176 Report.Comment ("Obj4 - Shouldn't get here");
|
|
|
177 end if;
|
|
|
178 end;
|
|
|
179
|
|
|
180 exception
|
|
|
181 when Constraint_Error => -- Exception expected.
|
|
|
182 null;
|
|
|
183 when others =>
|
|
|
184 Report.Failed ("Obj4 - others exception raised");
|
|
|
185 end;
|
|
|
186
|
|
|
187 exception
|
|
|
188 when Constraint_Error =>
|
|
|
189 Report.Failed ("Subtype_Rec - Constraint_Error raised");
|
|
|
190 when others =>
|
|
|
191 Report.Failed ("Subtype_Rec - others exception raised");
|
|
|
192 end;
|
|
|
193
|
|
|
194 ---------------------------------------------------------
|
|
|
195 begin
|
|
|
196 declare
|
|
|
197 type Arr is array (1..5) -- No Constraint_Error raised.
|
|
|
198 of Rec_Of_Rec_01(1);
|
|
|
199
|
|
|
200 begin
|
|
|
201 declare
|
|
|
202 Obj5 : Arr; -- Constraint_Error raised.
|
|
|
203 begin
|
|
|
204 Report.Failed ("Obj5 - Constraint_Error should be raised");
|
|
|
205 if Obj5 /= (1..5 => (1, (1, 1, others => (others => '*')))) then
|
|
|
206 Report.Comment ("Obj5 - Shouldn't get here");
|
|
|
207 end if;
|
|
|
208 end;
|
|
|
209
|
|
|
210 exception
|
|
|
211 when Constraint_Error => -- Exception expected.
|
|
|
212 null;
|
|
|
213 when others =>
|
|
|
214 Report.Failed ("Obj5 - others exception raised");
|
|
|
215 end;
|
|
|
216
|
|
|
217 exception
|
|
|
218 when Constraint_Error =>
|
|
|
219 Report.Failed ("Arr - Constraint_Error raised");
|
|
|
220 when others =>
|
|
|
221 Report.Failed ("Arr - others exception raised");
|
|
|
222 end;
|
|
|
223
|
|
|
224 ---------------------------------------------------------
|
|
|
225 begin
|
|
|
226 declare
|
|
|
227 type Rec_Of_Rec_Of_MyArr is
|
|
|
228 record
|
|
|
229 C1 : Rec_Of_MyArr_01(1); -- No Constraint_Error raised.
|
|
|
230 end record;
|
|
|
231 begin
|
|
|
232 declare
|
|
|
233 Obj6 : Rec_Of_Rec_Of_MyArr; -- Constraint_Error raised.
|
|
|
234 begin
|
|
|
235 Report.Failed ("Obj6 - Constraint_Error should be raised");
|
|
|
236 if Obj6 /= (C1 => (1, (1, 1))) then
|
|
|
237 Report.Comment ("Obj6 - Shouldn't get here");
|
|
|
238 end if;
|
|
|
239 end;
|
|
|
240
|
|
|
241 exception
|
|
|
242 when Constraint_Error => -- Exception expected.
|
|
|
243 null;
|
|
|
244 when others =>
|
|
|
245 Report.Failed ("Obj6 - others exception raised");
|
|
|
246 end;
|
|
|
247
|
|
|
248 exception
|
|
|
249 when Constraint_Error =>
|
|
|
250 Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
|
|
|
251 when others =>
|
|
|
252 Report.Failed ("Rec_Of_Rec_Of_MyArr - others exception raised");
|
|
|
253 end;
|
|
|
254
|
|
|
255 ---------------------------------------------------------
|
|
|
256 begin
|
|
|
257 declare
|
|
|
258 type New_Rec is
|
|
|
259 new Rec_Of_MyArr_01(1); -- No Constraint_Error raised.
|
|
|
260
|
|
|
261 begin
|
|
|
262 declare
|
|
|
263 Obj7 : New_Rec; -- Constraint_Error raised.
|
|
|
264 begin
|
|
|
265 Report.Failed ("Obj7 - Constraint_Error should be raised");
|
|
|
266 if Obj7 /= (1, (1, 1)) then
|
|
|
267 Report.Comment ("Obj7 - Shouldn't get here");
|
|
|
268 end if;
|
|
|
269 end;
|
|
|
270
|
|
|
271 exception
|
|
|
272 when Constraint_Error => -- Exception expected.
|
|
|
273 null;
|
|
|
274 when others =>
|
|
|
275 Report.Failed ("Obj7 - others exception raised");
|
|
|
276 end;
|
|
|
277
|
|
|
278 exception
|
|
|
279 when Constraint_Error =>
|
|
|
280 Report.Failed ("New_Rec - Constraint_Error raised");
|
|
|
281 when others =>
|
|
|
282 Report.Failed ("New_Rec - others exception raised");
|
|
|
283 end;
|
|
|
284
|
|
|
285 ---------------------------------------------------------
|
|
|
286 begin
|
|
|
287 declare
|
|
|
288 type Acc_Rec is
|
|
|
289 access Rec_Of_Rec_02 (Report.Ident_Int(0));
|
|
|
290 -- No Constraint_Error raised.
|
|
|
291 begin
|
|
|
292 declare
|
|
|
293 Obj8 : Acc_Rec; -- No Constraint_Error raised.
|
|
|
294
|
|
|
295 begin
|
|
|
296 Obj8 := new Rec_Of_Rec_02 (Report.Ident_Int(0));
|
|
|
297 -- Constraint_Error raised.
|
|
|
298
|
|
|
299 Report.Failed ("Obj8 - Constraint_Error should be raised");
|
|
|
300 if Obj8.all /= (D3 => 1,
|
|
|
301 C1 => (Disc1 => 1,
|
|
|
302 Disc2 => 1,
|
|
|
303 Str1 => (others => '*'),
|
|
|
304 Str2 => (others => '*'))) then
|
|
|
305 Report.Comment ("Obj8 - Shouldn't get here");
|
|
|
306 end if;
|
|
|
307 end;
|
|
|
308
|
|
|
309 exception
|
|
|
310 when Constraint_Error => -- Exception expected.
|
|
|
311 null;
|
|
|
312 when others =>
|
|
|
313 Report.Failed ("Obj8 - others exception raised");
|
|
|
314 end;
|
|
|
315
|
|
|
316 exception
|
|
|
317 when Constraint_Error =>
|
|
|
318 Report.Failed ("Acc_Rec - Constraint_Error raised");
|
|
|
319 when others =>
|
|
|
320 Report.Failed ("Acc_Rec - others exception raised");
|
|
|
321 end;
|
|
|
322
|
|
|
323 ---------------------------------------------------------
|
|
|
324 begin
|
|
|
325 declare
|
|
|
326 type Acc_Rec_MyArr is access
|
|
|
327 Rec_Of_MyArr_02; -- No Constraint_Error
|
|
|
328 -- raised for either
|
|
|
329 Obj9 : Acc_Rec_MyArr; -- declaration.
|
|
|
330
|
|
|
331 begin
|
|
|
332 Obj9 := new Rec_Of_MyArr_02 (Report.Ident_Int(0));
|
|
|
333 -- Constraint_Error raised.
|
|
|
334
|
|
|
335 Report.Failed ("Obj9 - Constraint_Error should be raised");
|
|
|
336
|
|
|
337 if Obj9.all /= (1, (1, 1)) then
|
|
|
338 Report.Comment ("Obj9 - Shouldn't get here");
|
|
|
339 end if;
|
|
|
340
|
|
|
341 exception
|
|
|
342 when Constraint_Error => -- Exception expected.
|
|
|
343 null;
|
|
|
344 when others =>
|
|
|
345 Report.Failed ("Obj9 - others exception raised");
|
|
|
346 end;
|
|
|
347
|
|
|
348 exception
|
|
|
349 when Constraint_Error =>
|
|
|
350 Report.Failed ("Acc_Rec_MyArr - Constraint_Error raised");
|
|
|
351 when others =>
|
|
|
352 Report.Failed ("Acc_Rec_MyArr - others exception raised");
|
|
|
353 end;
|
|
|
354
|
|
|
355 end;
|
|
|
356
|
|
|
357 Report.Result;
|
|
|
358
|
|
|
359 exception
|
|
|
360 when others =>
|
|
|
361 Report.Failed ("Discriminant value checked too soon");
|
|
|
362 Report.Result;
|
|
|
363
|
|
|
364 end C371002;
|
