diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a | 388 |
1 files changed, 388 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a new file mode 100644 index 000000000..f6823570b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a @@ -0,0 +1,388 @@ +-- C371001.A +-- +-- Grant of Unlimited Rights +-- +-- 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 +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- 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 +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- OBJECTIVE: +-- Check that if a discriminant constraint depends on a discriminant, +-- the evaluation of the expressions in the constraint is deferred +-- until an object of the subtype is created. Check for cases of +-- records with private type component. +-- +-- TEST DESCRIPTION: +-- This transition test defines record type and incomplete types with +-- discriminant components which depend on the discriminants. The +-- discriminants are calculated by function calls. The test verifies +-- that Constraint_Error is raised during the object creations when +-- values of discriminants are incompatible with the subtypes. +-- +-- Inspired by C37214A.ADA and C37216A.ADA. +-- +-- +-- CHANGE HISTORY: +-- 11 Apr 96 SAIC Initial version for ACVC 2.1. +-- 06 Oct 96 SAIC Added LM references. Replaced "others exception" +-- with "unexpected exception" +-- +--! + +with Report; + +procedure C371001 is + + subtype Small_Int is Integer range 1..10; + + Func1_Cons : Integer := 0; + + --------------------------------------------------------- + function Func1 return Integer is + begin + Func1_Cons := Func1_Cons + Report.Ident_Int(1); + return Func1_Cons; + end Func1; + + +begin + Report.Test ("C371001", "Check that if a discriminant constraint " & + "depends on a discriminant, the evaluation of the " & + "expressions in the constraint is deferred until " & + "object declarations"); + + --------------------------------------------------------- + -- Constraint checks on an object declaration of a record. + + begin + + declare + + package C371001_0 is + + type PT_W_Disc (D : Small_Int) is private; + type Rec_W_Private (D1 : Integer) is + record + C : PT_W_Disc (D1); + end record; + + type Rec (D3 : Integer) is + record + C1 : Rec_W_Private (D3); + end record; + + private + type PT_W_Disc (D : Small_Int) is + record + Str : String (1 .. D) := (others => '*'); + end record; + + end C371001_0; + + --=====================================================-- + + Obj : C371001_0.Rec(Report.Ident_Int(0)); -- Constraint_Error raised. + + begin + Report.Failed ("Obj - Constraint_Error should be raised"); + if Obj.C1.D1 /= 0 then + Report.Failed ("Obj - Shouldn't get here"); + end if; + + exception + when others => + Report.Failed ("Obj - exception raised too late"); + end; + + exception + when Constraint_Error => -- Exception expected. + null; + when others => + Report.Failed ("Obj - unexpected exception raised"); + end; + + ------------------------------------------------------------------- + -- Constraint checks on an object declaration of an array. + + begin + declare + + package C371001_1 is + + type PT_W_Disc (D : Small_Int) is private; + type Rec_W_Private (D1 : Integer) is + record + C : PT_W_Disc (D1); + end record; + + type Rec_01 (D3 : Integer) is + record + C1 : Rec_W_Private (D3); + end record; + + type Arr is array (1 .. 5) of + Rec_01(Report.Ident_Int(0)); -- No Constraint_Error + -- raised. + private + type PT_W_Disc (D : Small_Int) is + record + Str : String (1 .. D) := (others => '*'); + end record; + + end C371001_1; + + --=====================================================-- + + begin + declare + Obj1 : C371001_1.Arr; -- Constraint_Error raised. + begin + Report.Failed ("Obj1 - Constraint_Error should be raised"); + if Obj1(1).D3 /= 0 then + Report.Failed ("Obj1 - Shouldn't get here"); + end if; + + exception + when others => + Report.Failed ("Obj1 - exception raised too late"); + end; + + exception + when Constraint_Error => -- Exception expected. + null; + when others => + Report.Failed ("Obj1 - unexpected exception raised"); + end; + + exception + when Constraint_Error => + Report.Failed ("Arr - Constraint_Error raised"); + when others => + Report.Failed ("Arr - unexpected exception raised"); + end; + + + ------------------------------------------------------------------- + -- Constraint checks on an object declaration of an access type. + + begin + declare + + package C371001_2 is + + type PT_W_Disc (D : Small_Int) is private; + type Rec_W_Private (D1 : Integer) is + record + C : PT_W_Disc (D1); + end record; + + type Rec_02 (D3 : Integer) is + record + C1 : Rec_W_Private (D3); + end record; + + type Acc_Rec2 is access Rec_02 -- No Constraint_Error + (Report.Ident_Int(11)); -- raised. + + private + type PT_W_Disc (D : Small_Int) is + record + Str : String (1 .. D) := (others => '*'); + end record; + + end C371001_2; + + --=====================================================-- + + begin + declare + Obj2 : C371001_2.Acc_Rec2; -- No Constraint_Error + -- raised. + begin + Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11)); + -- Constraint_Error raised. + + Report.Failed ("Obj2 - Constraint_Error should be raised"); + if Obj2.D3 /= 1 then + Report.Failed ("Obj2 - Shouldn't get here"); + end if; + + exception + when Constraint_Error => -- Exception expected. + null; + when others => + Report.Failed ("Obj2 - unexpected exception raised in " & + "assignment"); + end; + + exception + when Constraint_Error => + Report.Failed ("Obj2 - Constraint_Error raised in declaration"); + when others => + Report.Failed ("Obj2 - unexpected exception raised in " & + "declaration"); + end; + + exception + when Constraint_Error => + Report.Failed ("Acc_Rec2 - Constraint_Error raised"); + when others => + Report.Failed ("Acc_Rec2 - unexpected exception raised"); + end; + + ------------------------------------------------------------------- + -- Constraint checks on an object declaration of a subtype. + + Func1_Cons := -1; + + begin + declare + + package C371001_3 is + + type PT_W_Disc (D1, D2 : Small_Int) is private; + type Rec_W_Private (D3, D4 : Integer) is + record + C : PT_W_Disc (D3, D4); + end record; + + type Rec_03 (D5 : Integer) is + record + C1 : Rec_W_Private (D5, Func1); -- Func1 evaluated, + end record; -- value 0. + + subtype Subtype_Rec is Rec_03(1); -- No Constraint_Error + -- raised. + private + type PT_W_Disc (D1, D2 : Small_Int) is + record + Str1 : String (1 .. D1) := (others => '*'); + Str2 : String (1 .. D2) := (others => '*'); + end record; + + end C371001_3; + + --=====================================================-- + + begin + declare + Obj3 : C371001_3.Subtype_Rec; -- Constraint_Error raised. + begin + Report.Failed ("Obj3 - Constraint_Error should be raised"); + if Obj3.D5 /= 1 then + Report.Failed ("Obj3 - Shouldn't get here"); + end if; + + exception + when others => + Report.Failed ("Obj3 - exception raised too late"); + end; + + exception + when Constraint_Error => -- Exception expected. + null; + when others => + Report.Failed ("Obj3 - unexpected exception raised"); + end; + + exception + when Constraint_Error => + Report.Failed ("Subtype_Rec - Constraint_Error raised"); + when others => + Report.Failed ("Subtype_Rec - unexpected exception raised"); + end; + + ------------------------------------------------------------------- + -- Constraint checks on an object declaration of an incomplete type. + + Func1_Cons := 10; + + begin + declare + + package C371001_4 is + + type Rec_04 (D3 : Integer); + type PT_W_Disc (D : Small_Int) is private; + type Rec_W_Private (D1, D2 : Small_Int) is + record + C : PT_W_Disc (D2); + end record; + + type Rec_04 (D3 : Integer) is + record + C1 : Rec_W_Private (D3, Func1); -- Func1 evaluated + end record; -- value 11. + + type Acc_Rec4 is access Rec_04 (1); -- No Constraint_Error + -- raised. + private + type PT_W_Disc (D : Small_Int) is + record + Str : String (1 .. D) := (others => '*'); + end record; + + end C371001_4; + + --=====================================================-- + + begin + declare + Obj4 : C371001_4.Acc_Rec4; -- No Constraint_Error + -- raised. + begin + Obj4 := new C371001_4.Rec_04 (1); -- Constraint_Error raised. + + Report.Failed ("Obj4 - Constraint_Error should be raised"); + if Obj4.D3 /= 1 then + Report.Failed ("Obj4 - Shouldn't get here"); + end if; + + exception + when Constraint_Error => -- Exception expected. + null; + when others => + Report.Failed ("Obj4 - unexpected exception raised in " & + "assignment"); + end; + + exception + when Constraint_Error => + Report.Failed ("Obj4 - Constraint_Error raised in declaration"); + when others => + Report.Failed ("Obj4 - unexpected exception raised in " & + "declaration"); + end; + + exception + when Constraint_Error => + Report.Failed ("Acc_Rec4 - Constraint_Error raised"); + when others => + Report.Failed ("Acc_Rec4 - unexpected exception raised"); + end; + + Report.Result; + +exception + when others => + Report.Failed ("Discriminant value checked too soon"); + Report.Result; + +end C371001; |