Subversion Repositories openrisc

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