1 |
149 |
jeremybenn |
-- 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;
|