diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c3a1001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c3a1001.a | 315 |
1 files changed, 0 insertions, 315 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c3a1001.a b/gcc/testsuite/ada/acats/tests/c3/c3a1001.a deleted file mode 100644 index 9b05b5da254..00000000000 --- a/gcc/testsuite/ada/acats/tests/c3/c3a1001.a +++ /dev/null @@ -1,315 +0,0 @@ --- 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; |