diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c3a1002.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c3a1002.a | 251 |
1 files changed, 0 insertions, 251 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c3a1002.a b/gcc/testsuite/ada/acats/tests/c3/c3a1002.a deleted file mode 100644 index 27d1f843c30..00000000000 --- a/gcc/testsuite/ada/acats/tests/c3/c3a1002.a +++ /dev/null @@ -1,251 +0,0 @@ --- C3A1002.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 tagged records and task 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 task types are declared with both --- default and non default values. Discriminants for tagged types are --- only declared without 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: --- 23 Oct 95 SAIC Initial prerelease version. --- 19 Oct 96 SAIC ACVC 2.1: modified test description. Initialized --- Int_Val. --- ---! - -package C3A1002_0 is - - subtype Small_Int is Integer range 1 .. 15; - - type Enu_Type is (M, F); - - type Tag_Type is tagged - record - I : Small_Int := 1; - end record; - - type NTag_Type (D : Small_Int) is new Tag_Type with - record - S : String (1 .. D) := "Aloha"; - end record; - - type Incomplete1; -- no discriminant - - type Incomplete2 (<>); -- unknown discriminant - - type Incomplete3; -- no discriminant - - type Incomplete4 (<>); -- unknown discriminant - - type Incomplete5; -- no discriminant - - type Incomplete6 (<>); -- unknown discriminant - - type Incomplete1 (D1 : Enu_Type) is tagged -- no discriminant/ - record -- explicit discriminant - case D1 is - when M => MInteger : Small_Int := 9; - when F => FInteger : Small_Int := 8; - end case; - end record; - - type Incomplete2 (D2 : Small_Int) is new -- unknown discriminant/ - Incomplete1 (D1 => F) with record -- explicit discriminant - ID : String (1 .. D2) := "ACVC95"; - end record; - - type Incomplete3 is new -- no discriminant/ - NTag_Type with record -- inherited discriminant - E : Enu_Type := M; - end record; - - type Incomplete4 is new -- unknown discriminant/ - NTag_Type (D => 3) with record -- inherited discriminant - E : Enu_Type := F; - end record; - - task type Incomplete5 (D5 : Enu_Type) is -- no discriminant/ - entry Read_Disc (P : out Enu_Type); -- explicit discriminant - end Incomplete5; - - task type Incomplete6 - (D6 : Small_Int := 4) is -- unknown discriminant/ - entry Read_Int (P : out Small_Int); -- explicit discriminant - end Incomplete6; - -end C3A1002_0; - - --==================================================================-- - -package body C3A1002_0 is - - task body Incomplete5 is - begin - select - accept Read_Disc (P : out Enu_Type) do - P := D5; - end Read_Disc; - or - terminate; - end select; - - end Incomplete5; - - ---------------------------------------------------------------------- - task body Incomplete6 is - begin - select - accept Read_Int (P : out Small_Int) do - P := D6; - end Read_Int; - or - terminate; - end select; - - end Incomplete6; - -end C3A1002_0; - - --==================================================================-- - -with Report; - -with C3A1002_0; -use C3A1002_0; - -procedure C3A1002 is - - Enum_Val : Enu_Type := M; - - Int_Val : Small_Int := 15; - - -- Discriminant value comes from default. - - Incomplete6_Obj_1 : Incomplete6; - - -- Discriminant value comes from explicit constraint. - - Incomplete1_Obj_1 : Incomplete1 (M); - - Incomplete2_Obj_1 : Incomplete2 (6); - - Incomplete5_Obj_1 : Incomplete5 (F); - - Incomplete6_Obj_2 : Incomplete6 (7); - - -- Discriminant value comes from assignment. - - Incomplete1_Obj_2 : Incomplete1 - := (F, 12); - - Incomplete3_Obj_1 : Incomplete3 - := (D => 2, S => "Hi", I => 10, E => F); - - Incomplete4_Obj_1 : Incomplete4 - := (E => M, D => 3, S => "Bye", I => 14); - -begin - - Report.Test ("C3A1002", "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 " & - "tagged records and task types"); - - -- Check the initial values. - - if (Incomplete6_Obj_1.D6 /= 4) then - Report.Failed ("Wrong initial value for Incomplete6_Obj_1"); - end if; - - -- Check the explicit values. - - if (Incomplete1_Obj_1.D1 /= M) or - (Incomplete1_Obj_1.MInteger /= 9) then - Report.Failed ("Wrong values for Incomplete1_Obj_1"); - end if; - - if (Incomplete2_Obj_1.D2 /= 6) or - (Incomplete2_Obj_1.FInteger /= 8) or - (Incomplete2_Obj_1.ID /= "ACVC95") then - Report.Failed ("Wrong values for Incomplete2_Obj_1"); - end if; - - if (Incomplete5_Obj_1.D5 /= F) then - Report.Failed ("Wrong value for Incomplete5_Obj_1"); - end if; - - Incomplete5_Obj_1.Read_Disc (Enum_Val); - - if (Enum_Val /= F) then - Report.Failed ("Wrong value for Enum_Val"); - end if; - - if (Incomplete6_Obj_2.D6 /= 7) then - Report.Failed ("Wrong value for Incomplete6_Obj_2"); - end if; - - Incomplete6_Obj_1.Read_Int (Int_Val); - - if (Int_Val /= 4) then - Report.Failed ("Wrong value for Int_Val"); - end if; - - -- Check the assigned values. - - if (Incomplete1_Obj_2.D1 /= F) or - (Incomplete1_Obj_2.FInteger /= 12) then - Report.Failed ("Wrong values for Incomplete1_Obj_2"); - end if; - - if (Incomplete3_Obj_1.D /= 2 ) or - (Incomplete3_Obj_1.I /= 10) or - (Incomplete3_Obj_1.E /= F ) or - (Incomplete3_Obj_1.S /= "Hi") then - Report.Failed ("Wrong values for Incomplete3_Obj_1"); - end if; - - if (Incomplete4_Obj_1.E /= M ) or - (Incomplete4_Obj_1.D /= 3) or - (Incomplete4_Obj_1.S /= "Bye") or - (Incomplete4_Obj_1.I /= 14) then - Report.Failed ("Wrong values for Incomplete4_Obj_1"); - end if; - - Report.Result; - -end C3A1002; |