-- C432003.A
|
-- C432003.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that if the type of the ancestor part of an extension aggregate
|
-- Check that if the type of the ancestor part of an extension aggregate
|
-- has discriminants that are not inherited by the type of the aggregate,
|
-- has discriminants that are not inherited by the type of the aggregate,
|
-- and the ancestor part is a subtype mark that denotes a constrained
|
-- and the ancestor part is a subtype mark that denotes a constrained
|
-- subtype, Constraint_Error is raised if: 1) any discriminant of the
|
-- subtype, Constraint_Error is raised if: 1) any discriminant of the
|
-- ancestor has a different value than that specified for a corresponding
|
-- ancestor has a different value than that specified for a corresponding
|
-- discriminant in the derived type definition for some ancestor of the
|
-- discriminant in the derived type definition for some ancestor of the
|
-- type of the aggregate, or 2) the value for the discriminant in the
|
-- type of the aggregate, or 2) the value for the discriminant in the
|
-- record association list is not the value of the corresponding
|
-- record association list is not the value of the corresponding
|
-- discriminant. Check that the components of the value of the
|
-- discriminant. Check that the components of the value of the
|
-- aggregate not given by the record component association list are
|
-- aggregate not given by the record component association list are
|
-- initialized by default as for an object of the ancestor type.
|
-- initialized by default as for an object of the ancestor type.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Consider:
|
-- Consider:
|
--
|
--
|
-- type T (D1: ...) is tagged ...
|
-- type T (D1: ...) is tagged ...
|
--
|
--
|
-- type DT is new T with ...
|
-- type DT is new T with ...
|
-- subtype ST is DT (D1 => 3); -- Constrained subtype.
|
-- subtype ST is DT (D1 => 3); -- Constrained subtype.
|
--
|
--
|
-- type NT1 (D2: ...) is new DT (D1 => D2) with null record;
|
-- type NT1 (D2: ...) is new DT (D1 => D2) with null record;
|
-- type NT2 (D2: ...) is new DT (D1 => 6) with null record;
|
-- type NT2 (D2: ...) is new DT (D1 => 6) with null record;
|
-- type NT3 is new DT (D1 => 6) with null record;
|
-- type NT3 is new DT (D1 => 6) with null record;
|
--
|
--
|
-- A: NT1 := (T with D2 => 6); -- OK: T is unconstrained.
|
-- A: NT1 := (T with D2 => 6); -- OK: T is unconstrained.
|
-- B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.
|
-- B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.
|
-- C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.
|
-- C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.
|
--
|
--
|
-- D: NT2 := (T with D2 => 4); -- OK: T is unconstrained.
|
-- D: NT2 := (T with D2 => 4); -- OK: T is unconstrained.
|
-- E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.
|
-- E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.
|
-- F: NT2 := (ST with . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.
|
-- F: NT2 := (ST with . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.
|
--
|
--
|
-- G: NT3 := (T with D1 => 6); -- OK: T is unconstrained.
|
-- G: NT3 := (T with D1 => 6); -- OK: T is unconstrained.
|
-- H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.
|
-- H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.
|
-- I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.
|
-- I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.
|
--
|
--
|
-- In A, B, D, E, G, and H the ancestor part is the name of an
|
-- In A, B, D, E, G, and H the ancestor part is the name of an
|
-- unconstrained subtype, so this rule does not apply. In C, F, and I
|
-- unconstrained subtype, so this rule does not apply. In C, F, and I
|
-- the ancestor part (ST) is the name of a constrained subtype of DT,
|
-- the ancestor part (ST) is the name of a constrained subtype of DT,
|
-- which is itself a derived type of a discriminated tagged type T. ST
|
-- which is itself a derived type of a discriminated tagged type T. ST
|
-- constrains the discriminant of DT (D1) to the value 3; thus, the
|
-- constrains the discriminant of DT (D1) to the value 3; thus, the
|
-- type of any extension aggregate for which ST is the ancestor part
|
-- type of any extension aggregate for which ST is the ancestor part
|
-- must have an ancestor which also constrained D1 to 3. F and I raise
|
-- must have an ancestor which also constrained D1 to 3. F and I raise
|
-- Constraint_Error because NT2 and NT3, respectively, constrain D1 to
|
-- Constraint_Error because NT2 and NT3, respectively, constrain D1 to
|
-- 6. C raises Constraint_Error because NT1 constrains D1 to the value
|
-- 6. C raises Constraint_Error because NT1 constrains D1 to the value
|
-- of D2, which is set to 6 in the record component association list of
|
-- of D2, which is set to 6 in the record component association list of
|
-- the aggregate.
|
-- the aggregate.
|
--
|
--
|
-- This test verifies each of the three scenarios above:
|
-- This test verifies each of the three scenarios above:
|
--
|
--
|
-- (1) Ancestor of type of aggregate constrains discriminant with
|
-- (1) Ancestor of type of aggregate constrains discriminant with
|
-- new discriminant.
|
-- new discriminant.
|
-- (2) Ancestor of type of aggregate constrains discriminant with
|
-- (2) Ancestor of type of aggregate constrains discriminant with
|
-- value, and has a new discriminant part.
|
-- value, and has a new discriminant part.
|
-- (3) Ancestor of type of aggregate constrains discriminant with
|
-- (3) Ancestor of type of aggregate constrains discriminant with
|
-- value, and has no discriminant part.
|
-- value, and has no discriminant part.
|
--
|
--
|
-- Verification is made for cases where the type of the aggregate is
|
-- Verification is made for cases where the type of the aggregate is
|
-- once- and twice-removed from the type of the ancestor part.
|
-- once- and twice-removed from the type of the ancestor part.
|
--
|
--
|
-- Additionally, a case is included where a new discriminant corresponds
|
-- Additionally, a case is included where a new discriminant corresponds
|
-- to multiple discriminants of the type of the ancestor part.
|
-- to multiple discriminants of the type of the ancestor part.
|
--
|
--
|
-- To test the portion of the objective concerning "initialization by
|
-- To test the portion of the objective concerning "initialization by
|
-- default," the test verifies that, after a successful aggregate
|
-- default," the test verifies that, after a successful aggregate
|
-- assignment, components not assigned an explicit value by the aggregate
|
-- assignment, components not assigned an explicit value by the aggregate
|
-- contain the default values for the corresponding components of the
|
-- contain the default values for the corresponding components of the
|
-- ancestor type.
|
-- ancestor type.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 15 Dec 94 SAIC Removed discriminant defaults from tagged types.
|
-- 15 Dec 94 SAIC Removed discriminant defaults from tagged types.
|
-- 17 Nov 95 SAIC ACVC 2.0.1 fixes: Corrected subtype constraint
|
-- 17 Nov 95 SAIC ACVC 2.0.1 fixes: Corrected subtype constraint
|
-- for component NT_C3.Str2. Added missing component
|
-- for component NT_C3.Str2. Added missing component
|
-- checks. Removed record component update from
|
-- checks. Removed record component update from
|
-- Avoid_Optimization. Fixed incorrect component
|
-- Avoid_Optimization. Fixed incorrect component
|
-- checks.
|
-- checks.
|
-- 02 Dec 95 SAIC ACVC 2.0.1 fixes: Corrected Failed comment for
|
-- 02 Dec 95 SAIC ACVC 2.0.1 fixes: Corrected Failed comment for
|
-- Q case.
|
-- Q case.
|
--
|
--
|
--!
|
--!
|
|
|
package C432003_0 is
|
package C432003_0 is
|
|
|
Default_String : constant String := "This is a default string"; -- len = 24
|
Default_String : constant String := "This is a default string"; -- len = 24
|
Another_String : constant String := "Another default string"; -- len = 22
|
Another_String : constant String := "Another default string"; -- len = 22
|
|
|
subtype Length is Natural range 0..255;
|
subtype Length is Natural range 0..255;
|
|
|
type ROOT (D1 : Length) is tagged
|
type ROOT (D1 : Length) is tagged
|
record
|
record
|
S1 : String (1..D1) := Default_String(1..D1);
|
S1 : String (1..D1) := Default_String(1..D1);
|
Acc : Natural := 356;
|
Acc : Natural := 356;
|
end record;
|
end record;
|
|
|
procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type
|
procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type
|
-- extensions.
|
-- extensions.
|
|
|
type Unconstrained_Der is new ROOT with
|
type Unconstrained_Der is new ROOT with
|
record
|
record
|
Str1 : String(1..5) := "abcde";
|
Str1 : String(1..5) := "abcde";
|
end record;
|
end record;
|
|
|
subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);
|
subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);
|
|
|
type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with
|
type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with
|
record
|
record
|
S2 : String(1..D2); -- Inherited discrim. constrained by
|
S2 : String(1..D2); -- Inherited discrim. constrained by
|
end record; -- new discriminant.
|
end record; -- new discriminant.
|
|
|
type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with
|
type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with
|
record
|
record
|
S3 : String(1..D3); -- Inherited discrim. constrained by
|
S3 : String(1..D3); -- Inherited discrim. constrained by
|
end record; -- new discriminant.
|
end record; -- new discriminant.
|
|
|
|
|
type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with
|
type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with
|
record
|
record
|
S2 : String(1..D2); -- Inherited discrim. constrained by
|
S2 : String(1..D2); -- Inherited discrim. constrained by
|
end record; -- explicit value.
|
end record; -- explicit value.
|
|
|
type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with
|
type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with
|
record
|
record
|
S3 : String(1..D3); -- Inherited discrim. constrained by
|
S3 : String(1..D3); -- Inherited discrim. constrained by
|
end record; -- explicit value.
|
end record; -- explicit value.
|
|
|
type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with
|
type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with
|
record
|
record
|
S2 : String(1..D2);
|
S2 : String(1..D2);
|
end record;
|
end record;
|
|
|
|
|
type NT_C1 is new Unconstrained_Der (D1 => 5) with
|
type NT_C1 is new Unconstrained_Der (D1 => 5) with
|
record
|
record
|
Str2 : String(1..5); -- Inherited discrim. constrained
|
Str2 : String(1..5); -- Inherited discrim. constrained
|
end record; -- No new value.
|
end record; -- No new value.
|
|
|
type NT_C2 (D2 : Length) is new NT_C1 with
|
type NT_C2 (D2 : Length) is new NT_C1 with
|
record
|
record
|
S2 : String(1..D2); -- Inherited discrim. not further
|
S2 : String(1..D2); -- Inherited discrim. not further
|
end record; -- constrained, new discriminant.
|
end record; -- constrained, new discriminant.
|
|
|
type NT_C3 is new Unconstrained_Der(D1 => 10) with
|
type NT_C3 is new Unconstrained_Der(D1 => 10) with
|
record
|
record
|
Str2 : String(1..5);
|
Str2 : String(1..5);
|
end record;
|
end record;
|
|
|
|
|
type MULTI_ROOT (D1 : Length; D2 : Length) is tagged
|
type MULTI_ROOT (D1 : Length; D2 : Length) is tagged
|
record
|
record
|
S1 : String (1..D1) := Default_String(1..D1);
|
S1 : String (1..D1) := Default_String(1..D1);
|
S2 : String (1..D2) := Another_String(1..D2);
|
S2 : String (1..D2) := Another_String(1..D2);
|
end record;
|
end record;
|
|
|
procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all
|
procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all
|
-- type extensions.
|
-- type extensions.
|
|
|
type Mult_Unconstr_Der is new MULTI_ROOT with
|
type Mult_Unconstr_Der is new MULTI_ROOT with
|
record
|
record
|
Str1 : String(1..8) := "AbCdEfGh"; -- Derived, no constraints.
|
Str1 : String(1..8) := "AbCdEfGh"; -- Derived, no constraints.
|
end record;
|
end record;
|
|
|
-- Subtypes with constrained discriminants.
|
-- Subtypes with constrained discriminants.
|
subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15, -- Disc. have
|
subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15, -- Disc. have
|
D2 => 20); -- diff values
|
D2 => 20); -- diff values
|
|
|
subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15, -- Disc. have
|
subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15, -- Disc. have
|
D2 => 15); -- same value
|
D2 => 15); -- same value
|
|
|
type Mult_NT_A1 (D3 : Length) is
|
type Mult_NT_A1 (D3 : Length) is
|
new Mult_Unconstr_Der (D1 => D3, D2 => D3) with
|
new Mult_Unconstr_Der (D1 => D3, D2 => D3) with
|
record
|
record
|
S3 : String(1..D3); -- Both inherited discriminants constrained
|
S3 : String(1..D3); -- Both inherited discriminants constrained
|
end record; -- by new discriminant.
|
end record; -- by new discriminant.
|
|
|
end C432003_0;
|
end C432003_0;
|
|
|
|
|
--=====================================================================--
|
--=====================================================================--
|
|
|
|
|
with Report;
|
with Report;
|
package body C432003_0 is
|
package body C432003_0 is
|
|
|
procedure Avoid_Optimization (Rec : in out ROOT) is
|
procedure Avoid_Optimization (Rec : in out ROOT) is
|
begin
|
begin
|
Rec.S1 := Report.Ident_Str(Rec.S1);
|
Rec.S1 := Report.Ident_Str(Rec.S1);
|
end Avoid_Optimization;
|
end Avoid_Optimization;
|
|
|
procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is
|
procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is
|
begin
|
begin
|
Rec.S1 := Report.Ident_Str(Rec.S1);
|
Rec.S1 := Report.Ident_Str(Rec.S1);
|
end Avoid_Optimization;
|
end Avoid_Optimization;
|
|
|
end C432003_0;
|
end C432003_0;
|
|
|
|
|
--=====================================================================--
|
--=====================================================================--
|
|
|
|
|
with C432003_0;
|
with C432003_0;
|
with Report;
|
with Report;
|
procedure C432003 is
|
procedure C432003 is
|
begin
|
begin
|
|
|
Report.Test("C432003", "Extension aggregates where ancestor part " &
|
Report.Test("C432003", "Extension aggregates where ancestor part " &
|
"is a subtype mark that denotes a constrained " &
|
"is a subtype mark that denotes a constrained " &
|
"subtype causing Constraint_Error if any " &
|
"subtype causing Constraint_Error if any " &
|
"discriminant of the ancestor has a different " &
|
"discriminant of the ancestor has a different " &
|
"value than that specified for a corresponding " &
|
"value than that specified for a corresponding " &
|
"discriminant in the derived type definition " &
|
"discriminant in the derived type definition " &
|
"for some ancestor of the type of the aggregate");
|
"for some ancestor of the type of the aggregate");
|
|
|
Test_Block:
|
Test_Block:
|
declare
|
declare
|
|
|
-- Variety of string object declarations.
|
-- Variety of string object declarations.
|
String2 : String(1..2) := Report.Ident_Str("12");
|
String2 : String(1..2) := Report.Ident_Str("12");
|
String5 : String(1..5) := Report.Ident_Str("12345");
|
String5 : String(1..5) := Report.Ident_Str("12345");
|
String8 : String(1..8) := Report.Ident_Str("AbCdEfGh");
|
String8 : String(1..8) := Report.Ident_Str("AbCdEfGh");
|
String10 : String(1..10) := Report.Ident_Str("1234567890");
|
String10 : String(1..10) := Report.Ident_Str("1234567890");
|
String15 : String(1..15) := Report.Ident_Str("123456789012345");
|
String15 : String(1..15) := Report.Ident_Str("123456789012345");
|
String20 : String(1..20) := Report.Ident_Str("12345678901234567890");
|
String20 : String(1..20) := Report.Ident_Str("12345678901234567890");
|
|
|
begin
|
begin
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
A : C432003_0.NT_A1 := -- OK
|
A : C432003_0.NT_A1 := -- OK
|
(C432003_0.ROOT with D2 => 5,
|
(C432003_0.ROOT with D2 => 5,
|
Str1 => "cdefg",
|
Str1 => "cdefg",
|
S2 => String5);
|
S2 => String5);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(A);
|
C432003_0.Avoid_Optimization(A);
|
if A.Acc /= 356 or
|
if A.Acc /= 356 or
|
A.Str1 /= "cdefg" or
|
A.Str1 /= "cdefg" or
|
A.S2 /= String5 or
|
A.S2 /= String5 or
|
A.D2 /= 5 or
|
A.D2 /= 5 or
|
A.S1 /= C432003_0.Default_String(1..5)
|
A.S1 /= C432003_0.Default_String(1..5)
|
then
|
then
|
Report.Failed("Incorrect object values for Object A");
|
Report.Failed("Incorrect object values for Object A");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object A");
|
Report.Failed("Constraint_Error raised for Object A");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
C: C432003_0.NT_A1 := -- OK
|
C: C432003_0.NT_A1 := -- OK
|
(C432003_0.Constrained_Subtype with D2 => 10,
|
(C432003_0.Constrained_Subtype with D2 => 10,
|
S2 => String10);
|
S2 => String10);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(C);
|
C432003_0.Avoid_Optimization(C);
|
if C.D2 /= 10 or C.Acc /= 356 or
|
if C.D2 /= 10 or C.Acc /= 356 or
|
C.Str1 /= "abcde" or C.S2 /= String10 or
|
C.Str1 /= "abcde" or C.S2 /= String10 or
|
C.S1 /= C432003_0.Default_String(1..10)
|
C.S1 /= C432003_0.Default_String(1..10)
|
then
|
then
|
Report.Failed("Incorrect object values for Object C");
|
Report.Failed("Incorrect object values for Object C");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object C");
|
Report.Failed("Constraint_Error raised for Object C");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
D: C432003_0.NT_A1 := -- C_E
|
D: C432003_0.NT_A1 := -- C_E
|
(C432003_0.Constrained_Subtype with
|
(C432003_0.Constrained_Subtype with
|
D2 => Report.Ident_Int(5),
|
D2 => Report.Ident_Int(5),
|
S2 => String5);
|
S2 => String5);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(D);
|
C432003_0.Avoid_Optimization(D);
|
Report.Failed("Constraint_Error not raised for Object D");
|
Report.Failed("Constraint_Error not raised for Object D");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
E: C432003_0.NT_A2 := -- OK
|
E: C432003_0.NT_A2 := -- OK
|
(C432003_0.Constrained_Subtype with D3 => 10,
|
(C432003_0.Constrained_Subtype with D3 => 10,
|
S2 => String10,
|
S2 => String10,
|
S3 => String10);
|
S3 => String10);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(E);
|
C432003_0.Avoid_Optimization(E);
|
if E.D3 /= 10 or E.Acc /= 356 or
|
if E.D3 /= 10 or E.Acc /= 356 or
|
E.Str1 /= "abcde" or E.S2 /= String10 or
|
E.Str1 /= "abcde" or E.S2 /= String10 or
|
E.S3 /= String10 or
|
E.S3 /= String10 or
|
E.S1 /= C432003_0.Default_String(1..10)
|
E.S1 /= C432003_0.Default_String(1..10)
|
then
|
then
|
Report.Failed("Incorrect object values for Object E");
|
Report.Failed("Incorrect object values for Object E");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object E");
|
Report.Failed("Constraint_Error raised for Object E");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
F: C432003_0.NT_A2 := -- C_E
|
F: C432003_0.NT_A2 := -- C_E
|
(C432003_0.Constrained_Subtype with
|
(C432003_0.Constrained_Subtype with
|
D3 => Report.Ident_Int(5),
|
D3 => Report.Ident_Int(5),
|
S2 => String5,
|
S2 => String5,
|
S3 => String5);
|
S3 => String5);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(F);
|
C432003_0.Avoid_Optimization(F);
|
Report.Failed("Constraint_Error not raised for Object F");
|
Report.Failed("Constraint_Error not raised for Object F");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
G: C432003_0.NT_B2 := -- OK
|
G: C432003_0.NT_B2 := -- OK
|
(C432003_0.ROOT with D3 => 5,
|
(C432003_0.ROOT with D3 => 5,
|
Str1 => "cdefg",
|
Str1 => "cdefg",
|
S2 => String10,
|
S2 => String10,
|
S3 => String5);
|
S3 => String5);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(G);
|
C432003_0.Avoid_Optimization(G);
|
if G.D3 /= 5 or G.Acc /= 356 or
|
if G.D3 /= 5 or G.Acc /= 356 or
|
G.Str1 /= "cdefg" or G.S2 /= String10 or
|
G.Str1 /= "cdefg" or G.S2 /= String10 or
|
G.S3 /= String5 or
|
G.S3 /= String5 or
|
G.S1 /= C432003_0.Default_String(1..5)
|
G.S1 /= C432003_0.Default_String(1..5)
|
then
|
then
|
Report.Failed("Incorrect object values for Object G");
|
Report.Failed("Incorrect object values for Object G");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object G");
|
Report.Failed("Constraint_Error raised for Object G");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
H: C432003_0.NT_B3 := -- OK
|
H: C432003_0.NT_B3 := -- OK
|
(C432003_0.Unconstrained_Der with D2 => 5,
|
(C432003_0.Unconstrained_Der with D2 => 5,
|
S2 => String5);
|
S2 => String5);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(H);
|
C432003_0.Avoid_Optimization(H);
|
if H.D2 /= 5 or H.Acc /= 356 or
|
if H.D2 /= 5 or H.Acc /= 356 or
|
H.Str1 /= "abcde" or H.S2 /= String5 or
|
H.Str1 /= "abcde" or H.S2 /= String5 or
|
H.S1 /= C432003_0.Default_String(1..10)
|
H.S1 /= C432003_0.Default_String(1..10)
|
then
|
then
|
Report.Failed("Incorrect object values for Object H");
|
Report.Failed("Incorrect object values for Object H");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object H");
|
Report.Failed("Constraint_Error raised for Object H");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
I: C432003_0.NT_B1 := -- C_E
|
I: C432003_0.NT_B1 := -- C_E
|
(C432003_0.Constrained_Subtype with
|
(C432003_0.Constrained_Subtype with
|
D2 => Report.Ident_Int(10),
|
D2 => Report.Ident_Int(10),
|
S2 => String10);
|
S2 => String10);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(I);
|
C432003_0.Avoid_Optimization(I);
|
Report.Failed("Constraint_Error not raised for Object I");
|
Report.Failed("Constraint_Error not raised for Object I");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
J: C432003_0.NT_B2 := -- C_E
|
J: C432003_0.NT_B2 := -- C_E
|
(C432003_0.Constrained_Subtype with
|
(C432003_0.Constrained_Subtype with
|
D3 => Report.Ident_Int(10),
|
D3 => Report.Ident_Int(10),
|
S2 => String10,
|
S2 => String10,
|
S3 => String10);
|
S3 => String10);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(J);
|
C432003_0.Avoid_Optimization(J);
|
Report.Failed("Constraint_Error not raised by Object J");
|
Report.Failed("Constraint_Error not raised by Object J");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
K: C432003_0.NT_B3 := -- OK
|
K: C432003_0.NT_B3 := -- OK
|
(C432003_0.Constrained_Subtype with D2 => 5,
|
(C432003_0.Constrained_Subtype with D2 => 5,
|
S2 => String5);
|
S2 => String5);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(K);
|
C432003_0.Avoid_Optimization(K);
|
if K.D2 /= 5 or K.Acc /= 356 or
|
if K.D2 /= 5 or K.Acc /= 356 or
|
K.Str1 /= "abcde" or K.S2 /= String5 or
|
K.Str1 /= "abcde" or K.S2 /= String5 or
|
K.S1 /= C432003_0.Default_String(1..10)
|
K.S1 /= C432003_0.Default_String(1..10)
|
then
|
then
|
Report.Failed("Incorrect object values for Object K");
|
Report.Failed("Incorrect object values for Object K");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object K");
|
Report.Failed("Constraint_Error raised for Object K");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
M: C432003_0.NT_C2 := -- OK
|
M: C432003_0.NT_C2 := -- OK
|
(C432003_0.ROOT with D2 => 10,
|
(C432003_0.ROOT with D2 => 10,
|
Str1 => "cdefg",
|
Str1 => "cdefg",
|
Str2 => String5,
|
Str2 => String5,
|
S2 => String10);
|
S2 => String10);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(M);
|
C432003_0.Avoid_Optimization(M);
|
if M.D2 /= 10 or M.Acc /= 356 or
|
if M.D2 /= 10 or M.Acc /= 356 or
|
M.Str1 /= "cdefg" or M.S2 /= String10 or
|
M.Str1 /= "cdefg" or M.S2 /= String10 or
|
M.Str2 /= String5 or
|
M.Str2 /= String5 or
|
M.S1 /= C432003_0.Default_String(1..5)
|
M.S1 /= C432003_0.Default_String(1..5)
|
then
|
then
|
Report.Failed("Incorrect object values for Object M");
|
Report.Failed("Incorrect object values for Object M");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object M");
|
Report.Failed("Constraint_Error raised for Object M");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
O: C432003_0.NT_C1 := -- C_E
|
O: C432003_0.NT_C1 := -- C_E
|
(C432003_0.Constrained_Subtype with
|
(C432003_0.Constrained_Subtype with
|
Str2 => Report.Ident_Str(String5));
|
Str2 => Report.Ident_Str(String5));
|
begin
|
begin
|
C432003_0.Avoid_Optimization(O);
|
C432003_0.Avoid_Optimization(O);
|
Report.Failed("Constraint_Error not raised for Object O");
|
Report.Failed("Constraint_Error not raised for Object O");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
P: C432003_0.NT_C2 := -- C_E
|
P: C432003_0.NT_C2 := -- C_E
|
(C432003_0.Constrained_Subtype with
|
(C432003_0.Constrained_Subtype with
|
D2 => Report.Ident_Int(10),
|
D2 => Report.Ident_Int(10),
|
Str2 => String5,
|
Str2 => String5,
|
S2 => String10);
|
S2 => String10);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(P);
|
C432003_0.Avoid_Optimization(P);
|
Report.Failed("Constraint_Error not raised by Object P");
|
Report.Failed("Constraint_Error not raised by Object P");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
Q: C432003_0.NT_C3 :=
|
Q: C432003_0.NT_C3 :=
|
(C432003_0.Constrained_Subtype with Str2 => String5); -- OK
|
(C432003_0.Constrained_Subtype with Str2 => String5); -- OK
|
begin
|
begin
|
C432003_0.Avoid_Optimization(Q);
|
C432003_0.Avoid_Optimization(Q);
|
if Q.Str2 /= String5 or
|
if Q.Str2 /= String5 or
|
Q.Acc /= 356 or
|
Q.Acc /= 356 or
|
Q.Str1 /= "abcde" or
|
Q.Str1 /= "abcde" or
|
Q.D1 /= 10 or
|
Q.D1 /= 10 or
|
Q.S1 /= C432003_0.Default_String(1..10)
|
Q.S1 /= C432003_0.Default_String(1..10)
|
then
|
then
|
Report.Failed("Incorrect object values for Object Q");
|
Report.Failed("Incorrect object values for Object Q");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object Q");
|
Report.Failed("Constraint_Error raised for Object Q");
|
end;
|
end;
|
|
|
|
|
-- The following cases test where a new discriminant corresponds
|
-- The following cases test where a new discriminant corresponds
|
-- to multiple discriminants of the type of the ancestor part.
|
-- to multiple discriminants of the type of the ancestor part.
|
|
|
begin
|
begin
|
declare
|
declare
|
S: C432003_0.Mult_NT_A1 := -- OK
|
S: C432003_0.Mult_NT_A1 := -- OK
|
(C432003_0.Mult_Unconstr_Der with D3 => 15,
|
(C432003_0.Mult_Unconstr_Der with D3 => 15,
|
S3 => String15);
|
S3 => String15);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(S);
|
C432003_0.Avoid_Optimization(S);
|
if S.S1 /= C432003_0.Default_String(1..15) or
|
if S.S1 /= C432003_0.Default_String(1..15) or
|
S.Str1 /= String8 or
|
S.Str1 /= String8 or
|
S.S2 /= C432003_0.Another_String(1..15) or
|
S.S2 /= C432003_0.Another_String(1..15) or
|
S.S3 /= String15 or
|
S.S3 /= String15 or
|
S.D3 /= 15
|
S.D3 /= 15
|
then
|
then
|
Report.Failed("Incorrect object values for Object S");
|
Report.Failed("Incorrect object values for Object S");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object S");
|
Report.Failed("Constraint_Error raised for Object S");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
U: C432003_0.Mult_NT_A1 := -- C_E
|
U: C432003_0.Mult_NT_A1 := -- C_E
|
(C432003_0.Mult_Constr_Sub1 with
|
(C432003_0.Mult_Constr_Sub1 with
|
D3 => Report.Ident_Int(15),
|
D3 => Report.Ident_Int(15),
|
S3 => String15);
|
S3 => String15);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(U);
|
C432003_0.Avoid_Optimization(U);
|
Report.Failed("Constraint_Error not raised for Object U");
|
Report.Failed("Constraint_Error not raised for Object U");
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
null; -- Raise of Constraint_Error is expected.
|
null; -- Raise of Constraint_Error is expected.
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
declare
|
declare
|
V: C432003_0.Mult_NT_A1 := -- OK
|
V: C432003_0.Mult_NT_A1 := -- OK
|
(C432003_0.Mult_Constr_Sub2 with D3 => 15,
|
(C432003_0.Mult_Constr_Sub2 with D3 => 15,
|
S3 => String15);
|
S3 => String15);
|
begin
|
begin
|
C432003_0.Avoid_Optimization(V);
|
C432003_0.Avoid_Optimization(V);
|
if V.D3 /= 15 or
|
if V.D3 /= 15 or
|
V.Str1 /= String8 or
|
V.Str1 /= String8 or
|
V.S3 /= String15 or
|
V.S3 /= String15 or
|
V.S1 /= C432003_0.Default_String(1..15) or
|
V.S1 /= C432003_0.Default_String(1..15) or
|
V.S2 /= C432003_0.Another_String(1..15)
|
V.S2 /= C432003_0.Another_String(1..15)
|
then
|
then
|
Report.Failed("Incorrect object values for Object V");
|
Report.Failed("Incorrect object values for Object V");
|
end if;
|
end if;
|
end;
|
end;
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed("Constraint_Error raised for Object V");
|
Report.Failed("Constraint_Error raised for Object V");
|
end;
|
end;
|
|
|
|
|
exception
|
exception
|
when others => Report.Failed("Exception raised in Test_Block");
|
when others => Report.Failed("Exception raised in Test_Block");
|
end Test_Block;
|
end Test_Block;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C432003;
|
end C432003;
|
|
|