-- 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;