-- C371001.A
|
-- C371001.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 a discriminant constraint depends on a discriminant,
|
-- Check that if a discriminant constraint depends on a discriminant,
|
-- the evaluation of the expressions in the constraint is deferred
|
-- the evaluation of the expressions in the constraint is deferred
|
-- until an object of the subtype is created. Check for cases of
|
-- until an object of the subtype is created. Check for cases of
|
-- records with private type component.
|
-- records with private type component.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This transition test defines record type and incomplete types with
|
-- This transition test defines record type and incomplete types with
|
-- discriminant components which depend on the discriminants. The
|
-- discriminant components which depend on the discriminants. The
|
-- discriminants are calculated by function calls. The test verifies
|
-- discriminants are calculated by function calls. The test verifies
|
-- that Constraint_Error is raised during the object creations when
|
-- that Constraint_Error is raised during the object creations when
|
-- values of discriminants are incompatible with the subtypes.
|
-- values of discriminants are incompatible with the subtypes.
|
--
|
--
|
-- Inspired by C37214A.ADA and C37216A.ADA.
|
-- Inspired by C37214A.ADA and C37216A.ADA.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 11 Apr 96 SAIC Initial version for ACVC 2.1.
|
-- 11 Apr 96 SAIC Initial version for ACVC 2.1.
|
-- 06 Oct 96 SAIC Added LM references. Replaced "others exception"
|
-- 06 Oct 96 SAIC Added LM references. Replaced "others exception"
|
-- with "unexpected exception"
|
-- with "unexpected exception"
|
--
|
--
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
|
|
procedure C371001 is
|
procedure C371001 is
|
|
|
subtype Small_Int is Integer range 1..10;
|
subtype Small_Int is Integer range 1..10;
|
|
|
Func1_Cons : Integer := 0;
|
Func1_Cons : Integer := 0;
|
|
|
---------------------------------------------------------
|
---------------------------------------------------------
|
function Func1 return Integer is
|
function Func1 return Integer is
|
begin
|
begin
|
Func1_Cons := Func1_Cons + Report.Ident_Int(1);
|
Func1_Cons := Func1_Cons + Report.Ident_Int(1);
|
return Func1_Cons;
|
return Func1_Cons;
|
end Func1;
|
end Func1;
|
|
|
|
|
begin
|
begin
|
Report.Test ("C371001", "Check that if a discriminant constraint " &
|
Report.Test ("C371001", "Check that if a discriminant constraint " &
|
"depends on a discriminant, the evaluation of the " &
|
"depends on a discriminant, the evaluation of the " &
|
"expressions in the constraint is deferred until " &
|
"expressions in the constraint is deferred until " &
|
"object declarations");
|
"object declarations");
|
|
|
---------------------------------------------------------
|
---------------------------------------------------------
|
-- Constraint checks on an object declaration of a record.
|
-- Constraint checks on an object declaration of a record.
|
|
|
begin
|
begin
|
|
|
declare
|
declare
|
|
|
package C371001_0 is
|
package C371001_0 is
|
|
|
type PT_W_Disc (D : Small_Int) is private;
|
type PT_W_Disc (D : Small_Int) is private;
|
type Rec_W_Private (D1 : Integer) is
|
type Rec_W_Private (D1 : Integer) is
|
record
|
record
|
C : PT_W_Disc (D1);
|
C : PT_W_Disc (D1);
|
end record;
|
end record;
|
|
|
type Rec (D3 : Integer) is
|
type Rec (D3 : Integer) is
|
record
|
record
|
C1 : Rec_W_Private (D3);
|
C1 : Rec_W_Private (D3);
|
end record;
|
end record;
|
|
|
private
|
private
|
type PT_W_Disc (D : Small_Int) is
|
type PT_W_Disc (D : Small_Int) is
|
record
|
record
|
Str : String (1 .. D) := (others => '*');
|
Str : String (1 .. D) := (others => '*');
|
end record;
|
end record;
|
|
|
end C371001_0;
|
end C371001_0;
|
|
|
--=====================================================--
|
--=====================================================--
|
|
|
Obj : C371001_0.Rec(Report.Ident_Int(0)); -- Constraint_Error raised.
|
Obj : C371001_0.Rec(Report.Ident_Int(0)); -- Constraint_Error raised.
|
|
|
begin
|
begin
|
Report.Failed ("Obj - Constraint_Error should be raised");
|
Report.Failed ("Obj - Constraint_Error should be raised");
|
if Obj.C1.D1 /= 0 then
|
if Obj.C1.D1 /= 0 then
|
Report.Failed ("Obj - Shouldn't get here");
|
Report.Failed ("Obj - Shouldn't get here");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed ("Obj - exception raised too late");
|
Report.Failed ("Obj - exception raised too late");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error => -- Exception expected.
|
when Constraint_Error => -- Exception expected.
|
null;
|
null;
|
when others =>
|
when others =>
|
Report.Failed ("Obj - unexpected exception raised");
|
Report.Failed ("Obj - unexpected exception raised");
|
end;
|
end;
|
|
|
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
-- Constraint checks on an object declaration of an array.
|
-- Constraint checks on an object declaration of an array.
|
|
|
begin
|
begin
|
declare
|
declare
|
|
|
package C371001_1 is
|
package C371001_1 is
|
|
|
type PT_W_Disc (D : Small_Int) is private;
|
type PT_W_Disc (D : Small_Int) is private;
|
type Rec_W_Private (D1 : Integer) is
|
type Rec_W_Private (D1 : Integer) is
|
record
|
record
|
C : PT_W_Disc (D1);
|
C : PT_W_Disc (D1);
|
end record;
|
end record;
|
|
|
type Rec_01 (D3 : Integer) is
|
type Rec_01 (D3 : Integer) is
|
record
|
record
|
C1 : Rec_W_Private (D3);
|
C1 : Rec_W_Private (D3);
|
end record;
|
end record;
|
|
|
type Arr is array (1 .. 5) of
|
type Arr is array (1 .. 5) of
|
Rec_01(Report.Ident_Int(0)); -- No Constraint_Error
|
Rec_01(Report.Ident_Int(0)); -- No Constraint_Error
|
-- raised.
|
-- raised.
|
private
|
private
|
type PT_W_Disc (D : Small_Int) is
|
type PT_W_Disc (D : Small_Int) is
|
record
|
record
|
Str : String (1 .. D) := (others => '*');
|
Str : String (1 .. D) := (others => '*');
|
end record;
|
end record;
|
|
|
end C371001_1;
|
end C371001_1;
|
|
|
--=====================================================--
|
--=====================================================--
|
|
|
begin
|
begin
|
declare
|
declare
|
Obj1 : C371001_1.Arr; -- Constraint_Error raised.
|
Obj1 : C371001_1.Arr; -- Constraint_Error raised.
|
begin
|
begin
|
Report.Failed ("Obj1 - Constraint_Error should be raised");
|
Report.Failed ("Obj1 - Constraint_Error should be raised");
|
if Obj1(1).D3 /= 0 then
|
if Obj1(1).D3 /= 0 then
|
Report.Failed ("Obj1 - Shouldn't get here");
|
Report.Failed ("Obj1 - Shouldn't get here");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed ("Obj1 - exception raised too late");
|
Report.Failed ("Obj1 - exception raised too late");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error => -- Exception expected.
|
when Constraint_Error => -- Exception expected.
|
null;
|
null;
|
when others =>
|
when others =>
|
Report.Failed ("Obj1 - unexpected exception raised");
|
Report.Failed ("Obj1 - unexpected exception raised");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Arr - Constraint_Error raised");
|
Report.Failed ("Arr - Constraint_Error raised");
|
when others =>
|
when others =>
|
Report.Failed ("Arr - unexpected exception raised");
|
Report.Failed ("Arr - unexpected exception raised");
|
end;
|
end;
|
|
|
|
|
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
-- Constraint checks on an object declaration of an access type.
|
-- Constraint checks on an object declaration of an access type.
|
|
|
begin
|
begin
|
declare
|
declare
|
|
|
package C371001_2 is
|
package C371001_2 is
|
|
|
type PT_W_Disc (D : Small_Int) is private;
|
type PT_W_Disc (D : Small_Int) is private;
|
type Rec_W_Private (D1 : Integer) is
|
type Rec_W_Private (D1 : Integer) is
|
record
|
record
|
C : PT_W_Disc (D1);
|
C : PT_W_Disc (D1);
|
end record;
|
end record;
|
|
|
type Rec_02 (D3 : Integer) is
|
type Rec_02 (D3 : Integer) is
|
record
|
record
|
C1 : Rec_W_Private (D3);
|
C1 : Rec_W_Private (D3);
|
end record;
|
end record;
|
|
|
type Acc_Rec2 is access Rec_02 -- No Constraint_Error
|
type Acc_Rec2 is access Rec_02 -- No Constraint_Error
|
(Report.Ident_Int(11)); -- raised.
|
(Report.Ident_Int(11)); -- raised.
|
|
|
private
|
private
|
type PT_W_Disc (D : Small_Int) is
|
type PT_W_Disc (D : Small_Int) is
|
record
|
record
|
Str : String (1 .. D) := (others => '*');
|
Str : String (1 .. D) := (others => '*');
|
end record;
|
end record;
|
|
|
end C371001_2;
|
end C371001_2;
|
|
|
--=====================================================--
|
--=====================================================--
|
|
|
begin
|
begin
|
declare
|
declare
|
Obj2 : C371001_2.Acc_Rec2; -- No Constraint_Error
|
Obj2 : C371001_2.Acc_Rec2; -- No Constraint_Error
|
-- raised.
|
-- raised.
|
begin
|
begin
|
Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11));
|
Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11));
|
-- Constraint_Error raised.
|
-- Constraint_Error raised.
|
|
|
Report.Failed ("Obj2 - Constraint_Error should be raised");
|
Report.Failed ("Obj2 - Constraint_Error should be raised");
|
if Obj2.D3 /= 1 then
|
if Obj2.D3 /= 1 then
|
Report.Failed ("Obj2 - Shouldn't get here");
|
Report.Failed ("Obj2 - Shouldn't get here");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when Constraint_Error => -- Exception expected.
|
when Constraint_Error => -- Exception expected.
|
null;
|
null;
|
when others =>
|
when others =>
|
Report.Failed ("Obj2 - unexpected exception raised in " &
|
Report.Failed ("Obj2 - unexpected exception raised in " &
|
"assignment");
|
"assignment");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Obj2 - Constraint_Error raised in declaration");
|
Report.Failed ("Obj2 - Constraint_Error raised in declaration");
|
when others =>
|
when others =>
|
Report.Failed ("Obj2 - unexpected exception raised in " &
|
Report.Failed ("Obj2 - unexpected exception raised in " &
|
"declaration");
|
"declaration");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Acc_Rec2 - Constraint_Error raised");
|
Report.Failed ("Acc_Rec2 - Constraint_Error raised");
|
when others =>
|
when others =>
|
Report.Failed ("Acc_Rec2 - unexpected exception raised");
|
Report.Failed ("Acc_Rec2 - unexpected exception raised");
|
end;
|
end;
|
|
|
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
-- Constraint checks on an object declaration of a subtype.
|
-- Constraint checks on an object declaration of a subtype.
|
|
|
Func1_Cons := -1;
|
Func1_Cons := -1;
|
|
|
begin
|
begin
|
declare
|
declare
|
|
|
package C371001_3 is
|
package C371001_3 is
|
|
|
type PT_W_Disc (D1, D2 : Small_Int) is private;
|
type PT_W_Disc (D1, D2 : Small_Int) is private;
|
type Rec_W_Private (D3, D4 : Integer) is
|
type Rec_W_Private (D3, D4 : Integer) is
|
record
|
record
|
C : PT_W_Disc (D3, D4);
|
C : PT_W_Disc (D3, D4);
|
end record;
|
end record;
|
|
|
type Rec_03 (D5 : Integer) is
|
type Rec_03 (D5 : Integer) is
|
record
|
record
|
C1 : Rec_W_Private (D5, Func1); -- Func1 evaluated,
|
C1 : Rec_W_Private (D5, Func1); -- Func1 evaluated,
|
end record; -- value 0.
|
end record; -- value 0.
|
|
|
subtype Subtype_Rec is Rec_03(1); -- No Constraint_Error
|
subtype Subtype_Rec is Rec_03(1); -- No Constraint_Error
|
-- raised.
|
-- raised.
|
private
|
private
|
type PT_W_Disc (D1, D2 : Small_Int) is
|
type PT_W_Disc (D1, D2 : Small_Int) is
|
record
|
record
|
Str1 : String (1 .. D1) := (others => '*');
|
Str1 : String (1 .. D1) := (others => '*');
|
Str2 : String (1 .. D2) := (others => '*');
|
Str2 : String (1 .. D2) := (others => '*');
|
end record;
|
end record;
|
|
|
end C371001_3;
|
end C371001_3;
|
|
|
--=====================================================--
|
--=====================================================--
|
|
|
begin
|
begin
|
declare
|
declare
|
Obj3 : C371001_3.Subtype_Rec; -- Constraint_Error raised.
|
Obj3 : C371001_3.Subtype_Rec; -- Constraint_Error raised.
|
begin
|
begin
|
Report.Failed ("Obj3 - Constraint_Error should be raised");
|
Report.Failed ("Obj3 - Constraint_Error should be raised");
|
if Obj3.D5 /= 1 then
|
if Obj3.D5 /= 1 then
|
Report.Failed ("Obj3 - Shouldn't get here");
|
Report.Failed ("Obj3 - Shouldn't get here");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed ("Obj3 - exception raised too late");
|
Report.Failed ("Obj3 - exception raised too late");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error => -- Exception expected.
|
when Constraint_Error => -- Exception expected.
|
null;
|
null;
|
when others =>
|
when others =>
|
Report.Failed ("Obj3 - unexpected exception raised");
|
Report.Failed ("Obj3 - unexpected exception raised");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Subtype_Rec - Constraint_Error raised");
|
Report.Failed ("Subtype_Rec - Constraint_Error raised");
|
when others =>
|
when others =>
|
Report.Failed ("Subtype_Rec - unexpected exception raised");
|
Report.Failed ("Subtype_Rec - unexpected exception raised");
|
end;
|
end;
|
|
|
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
-- Constraint checks on an object declaration of an incomplete type.
|
-- Constraint checks on an object declaration of an incomplete type.
|
|
|
Func1_Cons := 10;
|
Func1_Cons := 10;
|
|
|
begin
|
begin
|
declare
|
declare
|
|
|
package C371001_4 is
|
package C371001_4 is
|
|
|
type Rec_04 (D3 : Integer);
|
type Rec_04 (D3 : Integer);
|
type PT_W_Disc (D : Small_Int) is private;
|
type PT_W_Disc (D : Small_Int) is private;
|
type Rec_W_Private (D1, D2 : Small_Int) is
|
type Rec_W_Private (D1, D2 : Small_Int) is
|
record
|
record
|
C : PT_W_Disc (D2);
|
C : PT_W_Disc (D2);
|
end record;
|
end record;
|
|
|
type Rec_04 (D3 : Integer) is
|
type Rec_04 (D3 : Integer) is
|
record
|
record
|
C1 : Rec_W_Private (D3, Func1); -- Func1 evaluated
|
C1 : Rec_W_Private (D3, Func1); -- Func1 evaluated
|
end record; -- value 11.
|
end record; -- value 11.
|
|
|
type Acc_Rec4 is access Rec_04 (1); -- No Constraint_Error
|
type Acc_Rec4 is access Rec_04 (1); -- No Constraint_Error
|
-- raised.
|
-- raised.
|
private
|
private
|
type PT_W_Disc (D : Small_Int) is
|
type PT_W_Disc (D : Small_Int) is
|
record
|
record
|
Str : String (1 .. D) := (others => '*');
|
Str : String (1 .. D) := (others => '*');
|
end record;
|
end record;
|
|
|
end C371001_4;
|
end C371001_4;
|
|
|
--=====================================================--
|
--=====================================================--
|
|
|
begin
|
begin
|
declare
|
declare
|
Obj4 : C371001_4.Acc_Rec4; -- No Constraint_Error
|
Obj4 : C371001_4.Acc_Rec4; -- No Constraint_Error
|
-- raised.
|
-- raised.
|
begin
|
begin
|
Obj4 := new C371001_4.Rec_04 (1); -- Constraint_Error raised.
|
Obj4 := new C371001_4.Rec_04 (1); -- Constraint_Error raised.
|
|
|
Report.Failed ("Obj4 - Constraint_Error should be raised");
|
Report.Failed ("Obj4 - Constraint_Error should be raised");
|
if Obj4.D3 /= 1 then
|
if Obj4.D3 /= 1 then
|
Report.Failed ("Obj4 - Shouldn't get here");
|
Report.Failed ("Obj4 - Shouldn't get here");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when Constraint_Error => -- Exception expected.
|
when Constraint_Error => -- Exception expected.
|
null;
|
null;
|
when others =>
|
when others =>
|
Report.Failed ("Obj4 - unexpected exception raised in " &
|
Report.Failed ("Obj4 - unexpected exception raised in " &
|
"assignment");
|
"assignment");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Obj4 - Constraint_Error raised in declaration");
|
Report.Failed ("Obj4 - Constraint_Error raised in declaration");
|
when others =>
|
when others =>
|
Report.Failed ("Obj4 - unexpected exception raised in " &
|
Report.Failed ("Obj4 - unexpected exception raised in " &
|
"declaration");
|
"declaration");
|
end;
|
end;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Acc_Rec4 - Constraint_Error raised");
|
Report.Failed ("Acc_Rec4 - Constraint_Error raised");
|
when others =>
|
when others =>
|
Report.Failed ("Acc_Rec4 - unexpected exception raised");
|
Report.Failed ("Acc_Rec4 - unexpected exception raised");
|
end;
|
end;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed ("Discriminant value checked too soon");
|
Report.Failed ("Discriminant value checked too soon");
|
Report.Result;
|
Report.Result;
|
|
|
end C371001;
|
end C371001;
|
|
|
