diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a | 315 |
1 files changed, 315 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a new file mode 100644 index 000000000..9b05b5da2 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a @@ -0,0 +1,315 @@ +-- C3A1001.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 the full type completing a type with no discriminant part +-- or an unknown discriminant part may have explicitly declared or +-- inherited discriminants. +-- Check for cases where the types are records and protected types. +-- +-- TEST DESCRIPTION: +-- Declare two groups of incomplete types: one group with no discriminant +-- part and one group with unknown discriminant part. Both groups of +-- incomplete types are completed with both explicit and inherited +-- discriminants. Discriminants for record and protected types are +-- declared with default and non default values. +-- In the main program, verify that objects of both groups of incomplete +-- types can be created by default values or by assignments. +-- +-- +-- CHANGE HISTORY: +-- 11 Oct 95 SAIC Initial prerelease version. +-- 11 Nov 96 SAIC Revised for version 2.1. +-- +--! + +package C3A1001_0 is + + type Incomplete1 (<>); -- unknown discriminant + + type Incomplete2; -- no discriminant + + type Incomplete3 (<>); -- unknown discriminant + + type Incomplete4; -- no discriminant + + type Incomplete5 (<>); -- unknown discriminant + + type Incomplete6; -- no discriminant + + type Incomplete8; -- no discriminant + + subtype Small_Int is Integer range 1 .. 10; + + type Enu_Type is (M, F); + + type Incomplete1 (Disc : Enu_Type) is -- unknown discriminant/ + record -- explicit discriminant + case Disc is + when M => MInteger : Small_Int := 3; + when F => FInteger : Small_Int := 8; + end case; + end record; + + type Incomplete2 (Disc : Small_Int := 8) is -- no discriminant/ + record -- explicit discriminant + ID : String (1 .. Disc) := "Plymouth"; + end record; + + type Incomplete3 is new Incomplete2; -- unknown discriminant/ + -- inherited discriminant + + type Incomplete4 is new Incomplete2; -- no discriminant/ + -- inherited discriminant + + protected type Incomplete5 -- unknown discriminant/ + (Disc : Enu_Type) is -- explicit discriminant + function Get_Priv_Val return Enu_Type; + private + Enu_Obj : Enu_Type := Disc; + end Incomplete5; + + protected type Incomplete6 -- no discriminant/ + (Disc : Small_Int := 1) is -- explicit discriminant + function Get_Priv_Val return Small_Int; -- with default + private + Num : Small_Int := Disc; + end Incomplete6; + + type Incomplete8 (Disc : Small_Int) is -- no discriminant/ + record -- explicit discriminant + Str : String (1 .. Disc); -- no default + end record; + + type Incomplete9 is new Incomplete8; + + function Return_String (S : String) return String; + +end C3A1001_0; + + --==================================================================-- + +with Report; + +package body C3A1001_0 is + + protected body Incomplete5 is + + function Get_Priv_Val return Enu_Type is + begin + return Enu_Obj; + end Get_Priv_Val; + + end Incomplete5; + + ---------------------------------------------------------------------- + protected body Incomplete6 is + + function Get_Priv_Val return Small_Int is + begin + return Num; + end Get_Priv_Val; + + end Incomplete6; + + ---------------------------------------------------------------------- + function Return_String (S : String) return String is + begin + if Report.Ident_Bool(True) = True then + return S; + end if; + + return S; + end Return_String; + +end C3A1001_0; + + --==================================================================-- + +with Report; + +with C3A1001_0; +use C3A1001_0; + +procedure C3A1001 is + + -- Discriminant value comes from default. + + Incomplete2_Obj_1 : Incomplete2; + + Incomplete4_Obj_1 : Incomplete4; + + Incomplete6_Obj_1 : Incomplete6; + + -- Discriminant value comes from explicit constraint. + + Incomplete1_Obj_1 : Incomplete1 (F); + + Incomplete5_Obj_1 : Incomplete5 (M); + + Incomplete6_Obj_2 : Incomplete6 (2); + + -- Discriminant value comes from assignment. + + Incomplete3_Obj_1 : Incomplete3 := (Disc => 6, ID => "Sentra"); + + Incomplete1_Obj_2 : Incomplete1 := (Disc => M, MInteger => 9); + + Incomplete2_Obj_2 : Incomplete2 := (Disc => 5, ID => "Buick"); + +begin + + Report.Test ("C3A1001", "Check that the full type completing a type " & + "with no discriminant part or an unknown discriminant " & + "part may have explicitly declared or inherited " & + "discriminants. Check for cases where the types are " & + "records and protected types"); + + -- Check the initial values. + + if (Incomplete2_Obj_1.Disc /= 8) or + (Incomplete2_Obj_1.ID /= "Plymouth") then + Report.Failed ("Wrong initial values for Incomplete2_Obj_1"); + end if; + + if (Incomplete4_Obj_1.Disc /= 8) or + (Incomplete4_Obj_1.ID /= "Plymouth") then + Report.Failed ("Wrong initial values for Incomplete4_Obj_1"); + end if; + + if (Incomplete6_Obj_1.Disc /= 1) or + (Incomplete6_Obj_1.Get_Priv_Val /= 1) then + Report.Failed ("Wrong initial value for Incomplete6_Obj_1"); + end if; + + -- Check the explicit values. + + if (Incomplete1_Obj_1.Disc /= F) or + (Incomplete1_Obj_1.FInteger /= 8) then + Report.Failed ("Wrong values for Incomplete1_Obj_1"); + end if; + + if (Incomplete5_Obj_1.Disc /= M) or + (Incomplete5_Obj_1.Get_Priv_Val /= M) then + Report.Failed ("Wrong value for Incomplete5_Obj_1"); + end if; + + if (Incomplete6_Obj_2.Disc /= 2) or + (Incomplete6_Obj_2.Get_Priv_Val /= 2) then + Report.Failed ("Wrong value for Incomplete6_Obj_2"); + end if; + + -- Check the assigned values. + + if (Incomplete3_Obj_1.Disc /= 6) or + (Incomplete3_Obj_1.ID /= "Sentra") then + Report.Failed ("Wrong values for Incomplete3_Obj_1"); + end if; + + if (Incomplete1_Obj_2.Disc /= M) or + (Incomplete1_Obj_2.MInteger /= 9) then + Report.Failed ("Wrong values for Incomplete1_Obj_2"); + end if; + + if (Incomplete2_Obj_2.Disc /= 5) or + (Incomplete2_Obj_2.ID /= "Buick") then + Report.Failed ("Wrong values for Incomplete2_Obj_2"); + end if; + + -- Make sure that assignments work without problems. + + Incomplete1_Obj_1.FInteger := 1; + + -- Avoid optimization (dead variable removal of FInteger): + + if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1) + then + Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger"); + end if; + + Incomplete2_Obj_1.ID := Return_String ("12345678"); + + -- Avoid optimization (dead variable removal of ID) + + if Incomplete2_Obj_1.ID /= Return_String ("12345678") + then + Report.Failed ("Wrong values for Incomplete8_Obj_1.ID"); + end if; + + Incomplete4_Obj_1.ID := Return_String ("87654321"); + + -- Avoid optimization (dead variable removal of ID) + + if Incomplete4_Obj_1.ID /= Return_String ("87654321") + then + Report.Failed ("Wrong values for Incomplete4_Obj_1.ID"); + end if; + + + Test1: + declare + + Incomplete8_Obj_1 : Incomplete8 (10); + + begin + Incomplete8_Obj_1.Str := "Merry Xmas"; + + -- Avoid optimization (dead variable removal of Str): + + if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas" + then + Report.Failed ("Wrong values for Incomplete8_Obj_1.Str"); + end if; + + exception + when Constraint_Error => + Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1"); + + end Test1; + + Test2: + declare + + Incomplete8_Obj_2 : Incomplete8 (5); + + begin + Incomplete8_Obj_2.Str := "Happy"; + + -- Avoid optimization (dead variable removal of Str): + + if Return_String (Incomplete8_Obj_2.Str) /= "Happy" + then + Report.Failed ("Wrong values for Incomplete8_Obj_1.Str"); + end if; + + exception + when Constraint_Error => + Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2"); + + end Test2; + + Report.Result; + +end C3A1001; |