diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a | 251 |
1 files changed, 251 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a new file mode 100644 index 000000000..27d1f843c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a @@ -0,0 +1,251 @@ +-- 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; |