|
111
|
1 -- C432003.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 the type of the ancestor part of an extension aggregate
|
|
|
28 -- has discriminants that are not inherited by the type of the aggregate,
|
|
|
29 -- and the ancestor part is a subtype mark that denotes a constrained
|
|
|
30 -- subtype, Constraint_Error is raised if: 1) any discriminant of the
|
|
|
31 -- ancestor has a different value than that specified for a corresponding
|
|
|
32 -- discriminant in the derived type definition for some ancestor of the
|
|
|
33 -- type of the aggregate, or 2) the value for the discriminant in the
|
|
|
34 -- record association list is not the value of the corresponding
|
|
|
35 -- discriminant. Check that the components of the value of the
|
|
|
36 -- aggregate not given by the record component association list are
|
|
|
37 -- initialized by default as for an object of the ancestor type.
|
|
|
38 --
|
|
|
39 -- TEST DESCRIPTION:
|
|
|
40 -- Consider:
|
|
|
41 --
|
|
|
42 -- type T (D1: ...) is tagged ...
|
|
|
43 --
|
|
|
44 -- type DT is new T with ...
|
|
|
45 -- subtype ST is DT (D1 => 3); -- Constrained subtype.
|
|
|
46 --
|
|
|
47 -- type NT1 (D2: ...) is new DT (D1 => D2) with null record;
|
|
|
48 -- type NT2 (D2: ...) is new DT (D1 => 6) with null record;
|
|
|
49 -- type NT3 is new DT (D1 => 6) with null record;
|
|
|
50 --
|
|
|
51 -- A: NT1 := (T with D2 => 6); -- OK: T is unconstrained.
|
|
|
52 -- B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.
|
|
|
53 -- C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.
|
|
|
54 --
|
|
|
55 -- D: NT2 := (T with D2 => 4); -- OK: T is unconstrained.
|
|
|
56 -- E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.
|
|
|
57 -- F: NT2 := (ST with . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.
|
|
|
58 --
|
|
|
59 -- G: NT3 := (T with D1 => 6); -- OK: T is unconstrained.
|
|
|
60 -- H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.
|
|
|
61 -- I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.
|
|
|
62 --
|
|
|
63 -- In A, B, D, E, G, and H the ancestor part is the name of an
|
|
|
64 -- unconstrained subtype, so this rule does not apply. In C, F, and I
|
|
|
65 -- the ancestor part (ST) is the name of a constrained subtype of DT,
|
|
|
66 -- which is itself a derived type of a discriminated tagged type T. ST
|
|
|
67 -- constrains the discriminant of DT (D1) to the value 3; thus, the
|
|
|
68 -- type of any extension aggregate for which ST is the ancestor part
|
|
|
69 -- must have an ancestor which also constrained D1 to 3. F and I raise
|
|
|
70 -- Constraint_Error because NT2 and NT3, respectively, constrain D1 to
|
|
|
71 -- 6. C raises Constraint_Error because NT1 constrains D1 to the value
|
|
|
72 -- of D2, which is set to 6 in the record component association list of
|
|
|
73 -- the aggregate.
|
|
|
74 --
|
|
|
75 -- This test verifies each of the three scenarios above:
|
|
|
76 --
|
|
|
77 -- (1) Ancestor of type of aggregate constrains discriminant with
|
|
|
78 -- new discriminant.
|
|
|
79 -- (2) Ancestor of type of aggregate constrains discriminant with
|
|
|
80 -- value, and has a new discriminant part.
|
|
|
81 -- (3) Ancestor of type of aggregate constrains discriminant with
|
|
|
82 -- value, and has no discriminant part.
|
|
|
83 --
|
|
|
84 -- Verification is made for cases where the type of the aggregate is
|
|
|
85 -- once- and twice-removed from the type of the ancestor part.
|
|
|
86 --
|
|
|
87 -- Additionally, a case is included where a new discriminant corresponds
|
|
|
88 -- to multiple discriminants of the type of the ancestor part.
|
|
|
89 --
|
|
|
90 -- To test the portion of the objective concerning "initialization by
|
|
|
91 -- default," the test verifies that, after a successful aggregate
|
|
|
92 -- assignment, components not assigned an explicit value by the aggregate
|
|
|
93 -- contain the default values for the corresponding components of the
|
|
|
94 -- ancestor type.
|
|
|
95 --
|
|
|
96 --
|
|
|
97 -- CHANGE HISTORY:
|
|
|
98 -- 06 Dec 94 SAIC ACVC 2.0
|
|
|
99 -- 15 Dec 94 SAIC Removed discriminant defaults from tagged types.
|
|
|
100 -- 17 Nov 95 SAIC ACVC 2.0.1 fixes: Corrected subtype constraint
|
|
|
101 -- for component NT_C3.Str2. Added missing component
|
|
|
102 -- checks. Removed record component update from
|
|
|
103 -- Avoid_Optimization. Fixed incorrect component
|
|
|
104 -- checks.
|
|
|
105 -- 02 Dec 95 SAIC ACVC 2.0.1 fixes: Corrected Failed comment for
|
|
|
106 -- Q case.
|
|
|
107 --
|
|
|
108 --!
|
|
|
109
|
|
|
110 package C432003_0 is
|
|
|
111
|
|
|
112 Default_String : constant String := "This is a default string"; -- len = 24
|
|
|
113 Another_String : constant String := "Another default string"; -- len = 22
|
|
|
114
|
|
|
115 subtype Length is Natural range 0..255;
|
|
|
116
|
|
|
117 type ROOT (D1 : Length) is tagged
|
|
|
118 record
|
|
|
119 S1 : String (1..D1) := Default_String(1..D1);
|
|
|
120 Acc : Natural := 356;
|
|
|
121 end record;
|
|
|
122
|
|
|
123 procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type
|
|
|
124 -- extensions.
|
|
|
125
|
|
|
126 type Unconstrained_Der is new ROOT with
|
|
|
127 record
|
|
|
128 Str1 : String(1..5) := "abcde";
|
|
|
129 end record;
|
|
|
130
|
|
|
131 subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);
|
|
|
132
|
|
|
133 type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with
|
|
|
134 record
|
|
|
135 S2 : String(1..D2); -- Inherited discrim. constrained by
|
|
|
136 end record; -- new discriminant.
|
|
|
137
|
|
|
138 type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with
|
|
|
139 record
|
|
|
140 S3 : String(1..D3); -- Inherited discrim. constrained by
|
|
|
141 end record; -- new discriminant.
|
|
|
142
|
|
|
143
|
|
|
144 type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with
|
|
|
145 record
|
|
|
146 S2 : String(1..D2); -- Inherited discrim. constrained by
|
|
|
147 end record; -- explicit value.
|
|
|
148
|
|
|
149 type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with
|
|
|
150 record
|
|
|
151 S3 : String(1..D3); -- Inherited discrim. constrained by
|
|
|
152 end record; -- explicit value.
|
|
|
153
|
|
|
154 type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with
|
|
|
155 record
|
|
|
156 S2 : String(1..D2);
|
|
|
157 end record;
|
|
|
158
|
|
|
159
|
|
|
160 type NT_C1 is new Unconstrained_Der (D1 => 5) with
|
|
|
161 record
|
|
|
162 Str2 : String(1..5); -- Inherited discrim. constrained
|
|
|
163 end record; -- No new value.
|
|
|
164
|
|
|
165 type NT_C2 (D2 : Length) is new NT_C1 with
|
|
|
166 record
|
|
|
167 S2 : String(1..D2); -- Inherited discrim. not further
|
|
|
168 end record; -- constrained, new discriminant.
|
|
|
169
|
|
|
170 type NT_C3 is new Unconstrained_Der(D1 => 10) with
|
|
|
171 record
|
|
|
172 Str2 : String(1..5);
|
|
|
173 end record;
|
|
|
174
|
|
|
175
|
|
|
176 type MULTI_ROOT (D1 : Length; D2 : Length) is tagged
|
|
|
177 record
|
|
|
178 S1 : String (1..D1) := Default_String(1..D1);
|
|
|
179 S2 : String (1..D2) := Another_String(1..D2);
|
|
|
180 end record;
|
|
|
181
|
|
|
182 procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all
|
|
|
183 -- type extensions.
|
|
|
184
|
|
|
185 type Mult_Unconstr_Der is new MULTI_ROOT with
|
|
|
186 record
|
|
|
187 Str1 : String(1..8) := "AbCdEfGh"; -- Derived, no constraints.
|
|
|
188 end record;
|
|
|
189
|
|
|
190 -- Subtypes with constrained discriminants.
|
|
|
191 subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15, -- Disc. have
|
|
|
192 D2 => 20); -- diff values
|
|
|
193
|
|
|
194 subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15, -- Disc. have
|
|
|
195 D2 => 15); -- same value
|
|
|
196
|
|
|
197 type Mult_NT_A1 (D3 : Length) is
|
|
|
198 new Mult_Unconstr_Der (D1 => D3, D2 => D3) with
|
|
|
199 record
|
|
|
200 S3 : String(1..D3); -- Both inherited discriminants constrained
|
|
|
201 end record; -- by new discriminant.
|
|
|
202
|
|
|
203 end C432003_0;
|
|
|
204
|
|
|
205
|
|
|
206 --=====================================================================--
|
|
|
207
|
|
|
208
|
|
|
209 with Report;
|
|
|
210 package body C432003_0 is
|
|
|
211
|
|
|
212 procedure Avoid_Optimization (Rec : in out ROOT) is
|
|
|
213 begin
|
|
|
214 Rec.S1 := Report.Ident_Str(Rec.S1);
|
|
|
215 end Avoid_Optimization;
|
|
|
216
|
|
|
217 procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is
|
|
|
218 begin
|
|
|
219 Rec.S1 := Report.Ident_Str(Rec.S1);
|
|
|
220 end Avoid_Optimization;
|
|
|
221
|
|
|
222 end C432003_0;
|
|
|
223
|
|
|
224
|
|
|
225 --=====================================================================--
|
|
|
226
|
|
|
227
|
|
|
228 with C432003_0;
|
|
|
229 with Report;
|
|
|
230 procedure C432003 is
|
|
|
231 begin
|
|
|
232
|
|
|
233 Report.Test("C432003", "Extension aggregates where ancestor part " &
|
|
|
234 "is a subtype mark that denotes a constrained " &
|
|
|
235 "subtype causing Constraint_Error if any " &
|
|
|
236 "discriminant of the ancestor has a different " &
|
|
|
237 "value than that specified for a corresponding " &
|
|
|
238 "discriminant in the derived type definition " &
|
|
|
239 "for some ancestor of the type of the aggregate");
|
|
|
240
|
|
|
241 Test_Block:
|
|
|
242 declare
|
|
|
243
|
|
|
244 -- Variety of string object declarations.
|
|
|
245 String2 : String(1..2) := Report.Ident_Str("12");
|
|
|
246 String5 : String(1..5) := Report.Ident_Str("12345");
|
|
|
247 String8 : String(1..8) := Report.Ident_Str("AbCdEfGh");
|
|
|
248 String10 : String(1..10) := Report.Ident_Str("1234567890");
|
|
|
249 String15 : String(1..15) := Report.Ident_Str("123456789012345");
|
|
|
250 String20 : String(1..20) := Report.Ident_Str("12345678901234567890");
|
|
|
251
|
|
|
252 begin
|
|
|
253
|
|
|
254
|
|
|
255 begin
|
|
|
256 declare
|
|
|
257 A : C432003_0.NT_A1 := -- OK
|
|
|
258 (C432003_0.ROOT with D2 => 5,
|
|
|
259 Str1 => "cdefg",
|
|
|
260 S2 => String5);
|
|
|
261 begin
|
|
|
262 C432003_0.Avoid_Optimization(A);
|
|
|
263 if A.Acc /= 356 or
|
|
|
264 A.Str1 /= "cdefg" or
|
|
|
265 A.S2 /= String5 or
|
|
|
266 A.D2 /= 5 or
|
|
|
267 A.S1 /= C432003_0.Default_String(1..5)
|
|
|
268 then
|
|
|
269 Report.Failed("Incorrect object values for Object A");
|
|
|
270 end if;
|
|
|
271 end;
|
|
|
272 exception
|
|
|
273 when Constraint_Error =>
|
|
|
274 Report.Failed("Constraint_Error raised for Object A");
|
|
|
275 end;
|
|
|
276
|
|
|
277
|
|
|
278 begin
|
|
|
279 declare
|
|
|
280 C: C432003_0.NT_A1 := -- OK
|
|
|
281 (C432003_0.Constrained_Subtype with D2 => 10,
|
|
|
282 S2 => String10);
|
|
|
283 begin
|
|
|
284 C432003_0.Avoid_Optimization(C);
|
|
|
285 if C.D2 /= 10 or C.Acc /= 356 or
|
|
|
286 C.Str1 /= "abcde" or C.S2 /= String10 or
|
|
|
287 C.S1 /= C432003_0.Default_String(1..10)
|
|
|
288 then
|
|
|
289 Report.Failed("Incorrect object values for Object C");
|
|
|
290 end if;
|
|
|
291 end;
|
|
|
292 exception
|
|
|
293 when Constraint_Error =>
|
|
|
294 Report.Failed("Constraint_Error raised for Object C");
|
|
|
295 end;
|
|
|
296
|
|
|
297
|
|
|
298 begin
|
|
|
299 declare
|
|
|
300 D: C432003_0.NT_A1 := -- C_E
|
|
|
301 (C432003_0.Constrained_Subtype with
|
|
|
302 D2 => Report.Ident_Int(5),
|
|
|
303 S2 => String5);
|
|
|
304 begin
|
|
|
305 C432003_0.Avoid_Optimization(D);
|
|
|
306 Report.Failed("Constraint_Error not raised for Object D");
|
|
|
307 end;
|
|
|
308 exception
|
|
|
309 when Constraint_Error =>
|
|
|
310 null; -- Raise of Constraint_Error is expected.
|
|
|
311 end;
|
|
|
312
|
|
|
313
|
|
|
314 begin
|
|
|
315 declare
|
|
|
316 E: C432003_0.NT_A2 := -- OK
|
|
|
317 (C432003_0.Constrained_Subtype with D3 => 10,
|
|
|
318 S2 => String10,
|
|
|
319 S3 => String10);
|
|
|
320 begin
|
|
|
321 C432003_0.Avoid_Optimization(E);
|
|
|
322 if E.D3 /= 10 or E.Acc /= 356 or
|
|
|
323 E.Str1 /= "abcde" or E.S2 /= String10 or
|
|
|
324 E.S3 /= String10 or
|
|
|
325 E.S1 /= C432003_0.Default_String(1..10)
|
|
|
326 then
|
|
|
327 Report.Failed("Incorrect object values for Object E");
|
|
|
328 end if;
|
|
|
329 end;
|
|
|
330 exception
|
|
|
331 when Constraint_Error =>
|
|
|
332 Report.Failed("Constraint_Error raised for Object E");
|
|
|
333 end;
|
|
|
334
|
|
|
335
|
|
|
336 begin
|
|
|
337 declare
|
|
|
338 F: C432003_0.NT_A2 := -- C_E
|
|
|
339 (C432003_0.Constrained_Subtype with
|
|
|
340 D3 => Report.Ident_Int(5),
|
|
|
341 S2 => String5,
|
|
|
342 S3 => String5);
|
|
|
343 begin
|
|
|
344 C432003_0.Avoid_Optimization(F);
|
|
|
345 Report.Failed("Constraint_Error not raised for Object F");
|
|
|
346 end;
|
|
|
347 exception
|
|
|
348 when Constraint_Error =>
|
|
|
349 null; -- Raise of Constraint_Error is expected.
|
|
|
350 end;
|
|
|
351
|
|
|
352
|
|
|
353 begin
|
|
|
354 declare
|
|
|
355 G: C432003_0.NT_B2 := -- OK
|
|
|
356 (C432003_0.ROOT with D3 => 5,
|
|
|
357 Str1 => "cdefg",
|
|
|
358 S2 => String10,
|
|
|
359 S3 => String5);
|
|
|
360 begin
|
|
|
361 C432003_0.Avoid_Optimization(G);
|
|
|
362 if G.D3 /= 5 or G.Acc /= 356 or
|
|
|
363 G.Str1 /= "cdefg" or G.S2 /= String10 or
|
|
|
364 G.S3 /= String5 or
|
|
|
365 G.S1 /= C432003_0.Default_String(1..5)
|
|
|
366 then
|
|
|
367 Report.Failed("Incorrect object values for Object G");
|
|
|
368 end if;
|
|
|
369 end;
|
|
|
370 exception
|
|
|
371 when Constraint_Error =>
|
|
|
372 Report.Failed("Constraint_Error raised for Object G");
|
|
|
373 end;
|
|
|
374
|
|
|
375
|
|
|
376 begin
|
|
|
377 declare
|
|
|
378 H: C432003_0.NT_B3 := -- OK
|
|
|
379 (C432003_0.Unconstrained_Der with D2 => 5,
|
|
|
380 S2 => String5);
|
|
|
381 begin
|
|
|
382 C432003_0.Avoid_Optimization(H);
|
|
|
383 if H.D2 /= 5 or H.Acc /= 356 or
|
|
|
384 H.Str1 /= "abcde" or H.S2 /= String5 or
|
|
|
385 H.S1 /= C432003_0.Default_String(1..10)
|
|
|
386 then
|
|
|
387 Report.Failed("Incorrect object values for Object H");
|
|
|
388 end if;
|
|
|
389 end;
|
|
|
390 exception
|
|
|
391 when Constraint_Error =>
|
|
|
392 Report.Failed("Constraint_Error raised for Object H");
|
|
|
393 end;
|
|
|
394
|
|
|
395
|
|
|
396 begin
|
|
|
397 declare
|
|
|
398 I: C432003_0.NT_B1 := -- C_E
|
|
|
399 (C432003_0.Constrained_Subtype with
|
|
|
400 D2 => Report.Ident_Int(10),
|
|
|
401 S2 => String10);
|
|
|
402 begin
|
|
|
403 C432003_0.Avoid_Optimization(I);
|
|
|
404 Report.Failed("Constraint_Error not raised for Object I");
|
|
|
405 end;
|
|
|
406 exception
|
|
|
407 when Constraint_Error =>
|
|
|
408 null; -- Raise of Constraint_Error is expected.
|
|
|
409 end;
|
|
|
410
|
|
|
411
|
|
|
412 begin
|
|
|
413 declare
|
|
|
414 J: C432003_0.NT_B2 := -- C_E
|
|
|
415 (C432003_0.Constrained_Subtype with
|
|
|
416 D3 => Report.Ident_Int(10),
|
|
|
417 S2 => String10,
|
|
|
418 S3 => String10);
|
|
|
419 begin
|
|
|
420 C432003_0.Avoid_Optimization(J);
|
|
|
421 Report.Failed("Constraint_Error not raised by Object J");
|
|
|
422 end;
|
|
|
423 exception
|
|
|
424 when Constraint_Error =>
|
|
|
425 null; -- Raise of Constraint_Error is expected.
|
|
|
426 end;
|
|
|
427
|
|
|
428
|
|
|
429 begin
|
|
|
430 declare
|
|
|
431 K: C432003_0.NT_B3 := -- OK
|
|
|
432 (C432003_0.Constrained_Subtype with D2 => 5,
|
|
|
433 S2 => String5);
|
|
|
434 begin
|
|
|
435 C432003_0.Avoid_Optimization(K);
|
|
|
436 if K.D2 /= 5 or K.Acc /= 356 or
|
|
|
437 K.Str1 /= "abcde" or K.S2 /= String5 or
|
|
|
438 K.S1 /= C432003_0.Default_String(1..10)
|
|
|
439 then
|
|
|
440 Report.Failed("Incorrect object values for Object K");
|
|
|
441 end if;
|
|
|
442 end;
|
|
|
443 exception
|
|
|
444 when Constraint_Error =>
|
|
|
445 Report.Failed("Constraint_Error raised for Object K");
|
|
|
446 end;
|
|
|
447
|
|
|
448
|
|
|
449 begin
|
|
|
450 declare
|
|
|
451 M: C432003_0.NT_C2 := -- OK
|
|
|
452 (C432003_0.ROOT with D2 => 10,
|
|
|
453 Str1 => "cdefg",
|
|
|
454 Str2 => String5,
|
|
|
455 S2 => String10);
|
|
|
456 begin
|
|
|
457 C432003_0.Avoid_Optimization(M);
|
|
|
458 if M.D2 /= 10 or M.Acc /= 356 or
|
|
|
459 M.Str1 /= "cdefg" or M.S2 /= String10 or
|
|
|
460 M.Str2 /= String5 or
|
|
|
461 M.S1 /= C432003_0.Default_String(1..5)
|
|
|
462 then
|
|
|
463 Report.Failed("Incorrect object values for Object M");
|
|
|
464 end if;
|
|
|
465 end;
|
|
|
466 exception
|
|
|
467 when Constraint_Error =>
|
|
|
468 Report.Failed("Constraint_Error raised for Object M");
|
|
|
469 end;
|
|
|
470
|
|
|
471
|
|
|
472 begin
|
|
|
473 declare
|
|
|
474 O: C432003_0.NT_C1 := -- C_E
|
|
|
475 (C432003_0.Constrained_Subtype with
|
|
|
476 Str2 => Report.Ident_Str(String5));
|
|
|
477 begin
|
|
|
478 C432003_0.Avoid_Optimization(O);
|
|
|
479 Report.Failed("Constraint_Error not raised for Object O");
|
|
|
480 end;
|
|
|
481 exception
|
|
|
482 when Constraint_Error =>
|
|
|
483 null; -- Raise of Constraint_Error is expected.
|
|
|
484 end;
|
|
|
485
|
|
|
486
|
|
|
487 begin
|
|
|
488 declare
|
|
|
489 P: C432003_0.NT_C2 := -- C_E
|
|
|
490 (C432003_0.Constrained_Subtype with
|
|
|
491 D2 => Report.Ident_Int(10),
|
|
|
492 Str2 => String5,
|
|
|
493 S2 => String10);
|
|
|
494 begin
|
|
|
495 C432003_0.Avoid_Optimization(P);
|
|
|
496 Report.Failed("Constraint_Error not raised by Object P");
|
|
|
497 end;
|
|
|
498 exception
|
|
|
499 when Constraint_Error =>
|
|
|
500 null; -- Raise of Constraint_Error is expected.
|
|
|
501 end;
|
|
|
502
|
|
|
503
|
|
|
504 begin
|
|
|
505 declare
|
|
|
506 Q: C432003_0.NT_C3 :=
|
|
|
507 (C432003_0.Constrained_Subtype with Str2 => String5); -- OK
|
|
|
508 begin
|
|
|
509 C432003_0.Avoid_Optimization(Q);
|
|
|
510 if Q.Str2 /= String5 or
|
|
|
511 Q.Acc /= 356 or
|
|
|
512 Q.Str1 /= "abcde" or
|
|
|
513 Q.D1 /= 10 or
|
|
|
514 Q.S1 /= C432003_0.Default_String(1..10)
|
|
|
515 then
|
|
|
516 Report.Failed("Incorrect object values for Object Q");
|
|
|
517 end if;
|
|
|
518 end;
|
|
|
519 exception
|
|
|
520 when Constraint_Error =>
|
|
|
521 Report.Failed("Constraint_Error raised for Object Q");
|
|
|
522 end;
|
|
|
523
|
|
|
524
|
|
|
525 -- The following cases test where a new discriminant corresponds
|
|
|
526 -- to multiple discriminants of the type of the ancestor part.
|
|
|
527
|
|
|
528 begin
|
|
|
529 declare
|
|
|
530 S: C432003_0.Mult_NT_A1 := -- OK
|
|
|
531 (C432003_0.Mult_Unconstr_Der with D3 => 15,
|
|
|
532 S3 => String15);
|
|
|
533 begin
|
|
|
534 C432003_0.Avoid_Optimization(S);
|
|
|
535 if S.S1 /= C432003_0.Default_String(1..15) or
|
|
|
536 S.Str1 /= String8 or
|
|
|
537 S.S2 /= C432003_0.Another_String(1..15) or
|
|
|
538 S.S3 /= String15 or
|
|
|
539 S.D3 /= 15
|
|
|
540 then
|
|
|
541 Report.Failed("Incorrect object values for Object S");
|
|
|
542 end if;
|
|
|
543 end;
|
|
|
544 exception
|
|
|
545 when Constraint_Error =>
|
|
|
546 Report.Failed("Constraint_Error raised for Object S");
|
|
|
547 end;
|
|
|
548
|
|
|
549
|
|
|
550 begin
|
|
|
551 declare
|
|
|
552 U: C432003_0.Mult_NT_A1 := -- C_E
|
|
|
553 (C432003_0.Mult_Constr_Sub1 with
|
|
|
554 D3 => Report.Ident_Int(15),
|
|
|
555 S3 => String15);
|
|
|
556 begin
|
|
|
557 C432003_0.Avoid_Optimization(U);
|
|
|
558 Report.Failed("Constraint_Error not raised for Object U");
|
|
|
559 end;
|
|
|
560 exception
|
|
|
561 when Constraint_Error =>
|
|
|
562 null; -- Raise of Constraint_Error is expected.
|
|
|
563 end;
|
|
|
564
|
|
|
565
|
|
|
566 begin
|
|
|
567 declare
|
|
|
568 V: C432003_0.Mult_NT_A1 := -- OK
|
|
|
569 (C432003_0.Mult_Constr_Sub2 with D3 => 15,
|
|
|
570 S3 => String15);
|
|
|
571 begin
|
|
|
572 C432003_0.Avoid_Optimization(V);
|
|
|
573 if V.D3 /= 15 or
|
|
|
574 V.Str1 /= String8 or
|
|
|
575 V.S3 /= String15 or
|
|
|
576 V.S1 /= C432003_0.Default_String(1..15) or
|
|
|
577 V.S2 /= C432003_0.Another_String(1..15)
|
|
|
578 then
|
|
|
579 Report.Failed("Incorrect object values for Object V");
|
|
|
580 end if;
|
|
|
581 end;
|
|
|
582 exception
|
|
|
583 when Constraint_Error =>
|
|
|
584 Report.Failed("Constraint_Error raised for Object V");
|
|
|
585 end;
|
|
|
586
|
|
|
587
|
|
|
588 exception
|
|
|
589 when others => Report.Failed("Exception raised in Test_Block");
|
|
|
590 end Test_Block;
|
|
|
591
|
|
|
592 Report.Result;
|
|
|
593
|
|
|
594 end C432003;
|
