OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca13001.a] - Diff between revs 294 and 384

Only display areas with differences | Details | Blame | View Log

Rev 294 Rev 384
-- CA13001.A
-- CA13001.A
--
--
--                             Grant of Unlimited Rights
--                             Grant of Unlimited Rights
--
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     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
--     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 in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
--     this public release, the Government intends to confer upon all
--     this public release, the Government intends to confer upon all
--     recipients unlimited rights  equal to those held by the Government.
--     recipients unlimited rights  equal to those held by the Government.
--     These rights include rights to use, duplicate, release or disclose the
--     These rights include rights to use, duplicate, release or disclose the
--     released technical data and computer software in whole or in part, in
--     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
--     any manner and for any purpose whatsoever, and to have or permit others
--     to do so.
--     to do so.
--
--
--                                    DISCLAIMER
--                                    DISCLAIMER
--
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--*
--
--
-- OBJECTIVE:
-- OBJECTIVE:
--      Check that a separate protected unit declared in a non-generic child
--      Check that a separate protected unit declared in a non-generic child
--      unit of a private parent have the same visibility into its parent,
--      unit of a private parent have the same visibility into its parent,
--      its siblings, and packages on which its parent depends as is available
--      its siblings, and packages on which its parent depends as is available
--      at the point of their declaration.
--      at the point of their declaration.
--
--
-- TEST DESCRIPTION:
-- TEST DESCRIPTION:
--      A scenario is created that demonstrates the potential of having all
--      A scenario is created that demonstrates the potential of having all
--      members of one family to take out a transportation.  The restriction
--      members of one family to take out a transportation.  The restriction
--      is depend on each member to determine who can get a car, a clunker,
--      is depend on each member to determine who can get a car, a clunker,
--      or a bicycle.  If no transportation is available, that member has to
--      or a bicycle.  If no transportation is available, that member has to
--      walk.
--      walk.
--
--
--      Declare a package with location for each family member.  Declare
--      Declare a package with location for each family member.  Declare
--      a public parent package.  Declare a private child package. Declare a
--      a public parent package.  Declare a private child package. Declare a
--      public grandchild of this private package.  Declare a protected unit
--      public grandchild of this private package.  Declare a protected unit
--      as a subunit in a public grandchild package.  This subunit has
--      as a subunit in a public grandchild package.  This subunit has
--      visibility into it's parent body ancestor and its sibling.
--      visibility into it's parent body ancestor and its sibling.
--
--
--      Declare another public parent package.  The body of this package has
--      Declare another public parent package.  The body of this package has
--      visibility into its private sibling's descendants.
--      visibility into its private sibling's descendants.
--
--
--      In the main program, "with"s the parent package.  Check that the
--      In the main program, "with"s the parent package.  Check that the
--      protected subunit performs as expected.
--      protected subunit performs as expected.
--
--
--
--
-- CHANGE HISTORY:
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      06 Dec 94   SAIC    ACVC 2.0
--      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
--      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
--
--
--!
--!
package CA13001_0 is
package CA13001_0 is
   type Location is (School, Work, Beach, Home);
   type Location is (School, Work, Beach, Home);
   type Family is (Father, Mother, Teen);
   type Family is (Father, Mother, Teen);
   Destination : array (Family) of Location;
   Destination : array (Family) of Location;
   -- Other type definitions and procedure declarations in real application.
   -- Other type definitions and procedure declarations in real application.
end CA13001_0;
end CA13001_0;
-- No bodies required for CA13001_0.
-- No bodies required for CA13001_0.
     --==================================================================--
     --==================================================================--
-- Public parent.
-- Public parent.
package CA13001_1 is
package CA13001_1 is
   type Transportation is (Bicycle, Clunker, New_Car);
   type Transportation is (Bicycle, Clunker, New_Car);
   type Key_Type is private;
   type Key_Type is private;
   Walking : boolean := false;
   Walking : boolean := false;
   -- Other type definitions and procedure declarations in real application.
   -- Other type definitions and procedure declarations in real application.
private
private
   type Key_Type
   type Key_Type
     is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car);
     is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car);
end CA13001_1;
end CA13001_1;
-- No bodies required for CA13001_1.
-- No bodies required for CA13001_1.
     --==================================================================--
     --==================================================================--
-- Private child.
-- Private child.
private package CA13001_1.CA13001_2 is
private package CA13001_1.CA13001_2 is
   type Transport is
   type Transport is
      record
      record
         In_Use : boolean := false;
         In_Use : boolean := false;
      end record;
      end record;
   Vehicles : array (Transportation) of Transport;
   Vehicles : array (Transportation) of Transport;
   -- Other type definitions and procedure declarations in real application.
   -- Other type definitions and procedure declarations in real application.
end CA13001_1.CA13001_2;
end CA13001_1.CA13001_2;
-- No bodies required for CA13001_1.CA13001_2.
-- No bodies required for CA13001_1.CA13001_2.
     --==================================================================--
     --==================================================================--
-- Public grandchild of a private parent.
-- Public grandchild of a private parent.
package CA13001_1.CA13001_2.CA13001_3 is
package CA13001_1.CA13001_2.CA13001_3 is
   Flat_Tire : array (Transportation) of boolean := (others => false);
   Flat_Tire : array (Transportation) of boolean := (others => false);
   -- Other type definitions and procedure declarations in real application.
   -- Other type definitions and procedure declarations in real application.
end CA13001_1.CA13001_2.CA13001_3;
end CA13001_1.CA13001_2.CA13001_3;
-- No bodies required for CA13001_1.CA13001_2.CA13001_3.
-- No bodies required for CA13001_1.CA13001_2.CA13001_3.
     --==================================================================--
     --==================================================================--
-- Context clauses required for visibility needed by a separate subunit.
-- Context clauses required for visibility needed by a separate subunit.
with CA13001_0;
with CA13001_0;
use  CA13001_0;
use  CA13001_0;
-- Public grandchild of a private parent.
-- Public grandchild of a private parent.
package CA13001_1.CA13001_2.CA13001_4 is
package CA13001_1.CA13001_2.CA13001_4 is
   type Transit is
   type Transit is
      record
      record
         Available : boolean := false;
         Available : boolean := false;
      end record;
      end record;
   type Keys_Array is array (Transportation) of Transit;
   type Keys_Array is array (Transportation) of Transit;
   Fuel : array (Transportation) of boolean := (others => true);
   Fuel : array (Transportation) of boolean := (others => true);
   protected Family_Transportation is
   protected Family_Transportation is
      procedure Get_Vehicle (Who : in     Family;
      procedure Get_Vehicle (Who : in     Family;
                             Key :    out Key_Type);
                             Key :    out Key_Type);
      procedure Return_Vehicle (Tr : in Transportation);
      procedure Return_Vehicle (Tr : in Transportation);
      function TC_Verify (What : Transportation) return boolean;
      function TC_Verify (What : Transportation) return boolean;
   private
   private
      Keys : Keys_Array;
      Keys : Keys_Array;
   end Family_Transportation;
   end Family_Transportation;
end CA13001_1.CA13001_2.CA13001_4;
end CA13001_1.CA13001_2.CA13001_4;
     --==================================================================--
     --==================================================================--
-- Context clause required for visibility needed by a separate subunit.
-- Context clause required for visibility needed by a separate subunit.
with CA13001_1.CA13001_2.CA13001_3;    -- Public sibling.
with CA13001_1.CA13001_2.CA13001_3;    -- Public sibling.
package body CA13001_1.CA13001_2.CA13001_4 is
package body CA13001_1.CA13001_2.CA13001_4 is
   protected body Family_Transportation is separate;
   protected body Family_Transportation is separate;
end CA13001_1.CA13001_2.CA13001_4;
end CA13001_1.CA13001_2.CA13001_4;
     --==================================================================--
     --==================================================================--
separate (CA13001_1.CA13001_2.CA13001_4)
separate (CA13001_1.CA13001_2.CA13001_4)
protected body Family_Transportation is
protected body Family_Transportation is
   procedure Get_Vehicle (Who : in     Family;
   procedure Get_Vehicle (Who : in     Family;
                          Key :    out Key_Type) is
                          Key :    out Key_Type) is
   begin
   begin
      case Who is
      case Who is
         when Father|Mother =>
         when Father|Mother =>
            -- Drive new car to work
            -- Drive new car to work
            -- Reference package with'ed by the subunit parent's body.
            -- Reference package with'ed by the subunit parent's body.
            if Destination(Who) = Work then
            if Destination(Who) = Work then
               -- Reference type declared in the private parent of the subunit
               -- Reference type declared in the private parent of the subunit
               -- parent's body.
               -- parent's body.
               -- Reference type declared in the visible part of the
               -- Reference type declared in the visible part of the
               -- subunit parent's body.
               -- subunit parent's body.
               if not Vehicles(New_Car).In_Use and Fuel(New_Car)
               if not Vehicles(New_Car).In_Use and Fuel(New_Car)
                 -- Reference type declared in the public sibling of the
                 -- Reference type declared in the public sibling of the
                 -- subunit parent's body.
                 -- subunit parent's body.
                 and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then
                 and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then
                    Vehicles(New_Car).In_Use := true;
                    Vehicles(New_Car).In_Use := true;
                    -- Reference type declared in the private part of the
                    -- Reference type declared in the private part of the
                    -- protected subunit.
                    -- protected subunit.
                    Keys(New_Car).Available := false;
                    Keys(New_Car).Available := false;
                    Key                     := Transportation'pos(New_Car);
                    Key                     := Transportation'pos(New_Car);
               else
               else
                 -- Reference type declared in the grandparent of the subunit
                 -- Reference type declared in the grandparent of the subunit
                 -- parent's body.
                 -- parent's body.
                 Walking := true;
                 Walking := true;
               end if;
               end if;
            -- Drive clunker to other destinations.
            -- Drive clunker to other destinations.
            else
            else
               if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not
               if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not
                 CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
                 CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
                    Vehicles(Clunker).In_Use := true;
                    Vehicles(Clunker).In_Use := true;
                    Keys(Clunker).Available  := false;
                    Keys(Clunker).Available  := false;
                    Key                      := Transportation'pos(Clunker);
                    Key                      := Transportation'pos(Clunker);
               else
               else
                 Walking := true;
                 Walking := true;
                 Key     := Transportation'pos(Bicycle);
                 Key     := Transportation'pos(Bicycle);
               end if;
               end if;
            end if;
            end if;
         -- Similar for Teen.
         -- Similar for Teen.
         when Teen =>
         when Teen =>
            if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not
            if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not
              CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
              CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
                 Vehicles(Clunker).In_Use := true;
                 Vehicles(Clunker).In_Use := true;
                 Keys(Clunker).Available  := false;
                 Keys(Clunker).Available  := false;
                 Key                      := Transportation'pos(Clunker);
                 Key                      := Transportation'pos(Clunker);
            else
            else
               Walking := true;
               Walking := true;
               Key     := Transportation'pos(Bicycle);
               Key     := Transportation'pos(Bicycle);
            end if;
            end if;
      end case;
      end case;
   end Get_Vehicle;
   end Get_Vehicle;
   ----------------------------------------------------------------
   ----------------------------------------------------------------
   -- Any family member can bring back the transportation with the key.
   -- Any family member can bring back the transportation with the key.
   procedure Return_Vehicle (Tr : in Transportation) is
   procedure Return_Vehicle (Tr : in Transportation) is
   begin
   begin
      Vehicles(Tr).In_Use := false;
      Vehicles(Tr).In_Use := false;
      Keys(Tr).Available  := true;
      Keys(Tr).Available  := true;
   end Return_Vehicle;
   end Return_Vehicle;
   ----------------------------------------------------------------
   ----------------------------------------------------------------
   function TC_Verify (What : Transportation) return boolean is
   function TC_Verify (What : Transportation) return boolean is
   begin
   begin
      return Keys(What).Available;
      return Keys(What).Available;
   end TC_Verify;
   end TC_Verify;
end Family_Transportation;
end Family_Transportation;
     --==================================================================--
     --==================================================================--
with CA13001_0;
with CA13001_0;
use  CA13001_0;
use  CA13001_0;
-- Public child.
-- Public child.
package CA13001_1.CA13001_5 is
package CA13001_1.CA13001_5 is
   -- In a real application, tasks could be used to demonstrate
   -- In a real application, tasks could be used to demonstrate
   -- a family transportation scenario, i.e., each member of
   -- a family transportation scenario, i.e., each member of
   -- a family can take a vehicle out concurrently, then return
   -- a family can take a vehicle out concurrently, then return
   -- them at the same time. For the purposes of the test, family
   -- them at the same time. For the purposes of the test, family
   -- transportation happens sequentially.
   -- transportation happens sequentially.
   procedure Provide_Transportation (Who     : in     Family;
   procedure Provide_Transportation (Who     : in     Family;
                                     Get_Key :    out Key_Type;
                                     Get_Key :    out Key_Type;
                                     Get_Veh :    out boolean);
                                     Get_Veh :    out boolean);
   procedure Return_Transportation (What   : in     Transportation;
   procedure Return_Transportation (What   : in     Transportation;
                                    Rt_Veh :    out boolean);
                                    Rt_Veh :    out boolean);
end CA13001_1.CA13001_5;
end CA13001_1.CA13001_5;
     --==================================================================--
     --==================================================================--
with CA13001_1.CA13001_2.CA13001_4;   -- Public grandchild of a private parent,
with CA13001_1.CA13001_2.CA13001_4;   -- Public grandchild of a private parent,
                                      -- implicitly with CA13001_1.CA13001_2.
                                      -- implicitly with CA13001_1.CA13001_2.
package body CA13001_1.CA13001_5 is
package body CA13001_1.CA13001_5 is
   package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4;
   package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4;
   use Transportation_Pkg;
   use Transportation_Pkg;
   -- These two validation subprograms provide the capability to check the
   -- These two validation subprograms provide the capability to check the
   -- components defined in the private packages from within the client
   -- components defined in the private packages from within the client
   -- program.
   -- program.
   procedure Provide_Transportation (Who     : in     Family;
   procedure Provide_Transportation (Who     : in     Family;
                                     Get_Key :    out Key_Type;
                                     Get_Key :    out Key_Type;
                                     Get_Veh :    out boolean) is
                                     Get_Veh :    out boolean) is
   begin
   begin
      -- Goto work, school, or to the beach.
      -- Goto work, school, or to the beach.
      Family_Transportation.Get_Vehicle (Who, Get_Key);
      Family_Transportation.Get_Vehicle (Who, Get_Key);
      if not Family_Transportation.TC_Verify
      if not Family_Transportation.TC_Verify
        (Transportation'Val(Get_Key)) then
        (Transportation'Val(Get_Key)) then
           Get_Veh := true;
           Get_Veh := true;
      else
      else
         Get_Veh := false;
         Get_Veh := false;
      end if;
      end if;
   end Provide_Transportation;
   end Provide_Transportation;
   ----------------------------------------------------------------
   ----------------------------------------------------------------
   procedure Return_Transportation (What   : in     Transportation;
   procedure Return_Transportation (What   : in     Transportation;
                                    Rt_Veh :    out boolean) is
                                    Rt_Veh :    out boolean) is
   begin
   begin
      Family_Transportation.Return_Vehicle (What);
      Family_Transportation.Return_Vehicle (What);
      if Family_Transportation.TC_Verify(What) and
      if Family_Transportation.TC_Verify(What) and
        not CA13001_1.CA13001_2.Vehicles(What).In_Use then
        not CA13001_1.CA13001_2.Vehicles(What).In_Use then
           Rt_Veh := true;
           Rt_Veh := true;
      else
      else
         Rt_Veh := false;
         Rt_Veh := false;
      end if;
      end if;
   end Return_Transportation;
   end Return_Transportation;
end CA13001_1.CA13001_5;
end CA13001_1.CA13001_5;
     --==================================================================--
     --==================================================================--
with CA13001_0;
with CA13001_0;
with CA13001_1.CA13001_5;        -- Implicitly with parent, CA13001_1.
with CA13001_1.CA13001_5;        -- Implicitly with parent, CA13001_1.
with Report;
with Report;
procedure CA13001 is
procedure CA13001 is
   Mommy           : CA13001_0.Family := CA13001_0.Mother;
   Mommy           : CA13001_0.Family := CA13001_0.Mother;
   Daddy           : CA13001_0.Family := CA13001_0.Father;
   Daddy           : CA13001_0.Family := CA13001_0.Father;
   BG              : CA13001_0.Family := CA13001_0.Teen;
   BG              : CA13001_0.Family := CA13001_0.Teen;
   BG_Clunker      : CA13001_1.Transportation := CA13001_1.Clunker;
   BG_Clunker      : CA13001_1.Transportation := CA13001_1.Clunker;
   Get_Key         : CA13001_1.Key_Type;
   Get_Key         : CA13001_1.Key_Type;
   Get_Transit     : boolean := false;
   Get_Transit     : boolean := false;
   Return_Transit  : boolean := false;
   Return_Transit  : boolean := false;
begin
begin
   Report.Test ("CA13001", "Check that a protected subunit declared in " &
   Report.Test ("CA13001", "Check that a protected subunit declared in " &
                "a child unit of a private parent have the same visibility " &
                "a child unit of a private parent have the same visibility " &
                "into its parent, its parent's siblings, and packages on " &
                "into its parent, its parent's siblings, and packages on " &
                "which its parent depends");
                "which its parent depends");
   -- Get transportation for mother to go to work.
   -- Get transportation for mother to go to work.
   CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work;
   CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work;
   CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit);
   CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit);
   if not Get_Transit then
   if not Get_Transit then
      Report.Failed ("Failed to get mother transportation");
      Report.Failed ("Failed to get mother transportation");
   end if;
   end if;
   -- Get transportation for teen to go to school.
   -- Get transportation for teen to go to school.
   CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School;
   CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School;
   Get_Transit := false;
   Get_Transit := false;
   CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit);
   CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit);
   if not Get_Transit then
   if not Get_Transit then
      Report.Failed ("Failed to get teen transportation");
      Report.Failed ("Failed to get teen transportation");
   end if;
   end if;
   -- Get transportation for father to go to the beach.
   -- Get transportation for father to go to the beach.
   CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach;
   CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach;
   Get_Transit := false;
   Get_Transit := false;
   CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit);
   CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit);
   if Get_Transit and not CA13001_1.Walking then
   if Get_Transit and not CA13001_1.Walking then
      Report.Failed ("Failed to make daddy to walk to the beach");
      Report.Failed ("Failed to make daddy to walk to the beach");
   end if;
   end if;
   -- Return the clunker.
   -- Return the clunker.
   CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit);
   CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit);
   if not Return_Transit then
   if not Return_Transit then
      Report.Failed ("Failed to get back the clunker");
      Report.Failed ("Failed to get back the clunker");
   end if;
   end if;
   Report.Result;
   Report.Result;
end CA13001;
end CA13001;
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.