| -- CA13001.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 a separate protected unit declared in a non-generic child |
| -- unit of a private parent have the same visibility into its parent, |
| -- its siblings, and packages on which its parent depends as is available |
| -- at the point of their declaration. |
| -- |
| -- TEST DESCRIPTION: |
| -- A scenario is created that demonstrates the potential of having all |
| -- 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, |
| -- or a bicycle. If no transportation is available, that member has to |
| -- walk. |
| -- |
| -- Declare a package with location for each family member. Declare |
| -- a public parent package. Declare a private child package. Declare a |
| -- public grandchild of this private package. Declare a protected unit |
| -- as a subunit in a public grandchild package. This subunit has |
| -- visibility into it's parent body ancestor and its sibling. |
| -- |
| -- Declare another public parent package. The body of this package has |
| -- visibility into its private sibling's descendants. |
| -- |
| -- In the main program, "with"s the parent package. Check that the |
| -- protected subunit performs as expected. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- 16 Nov 95 SAIC Update and repair for ACVC 2.0.1 |
| -- |
| --! |
| |
| package CA13001_0 is |
| |
| type Location is (School, Work, Beach, Home); |
| type Family is (Father, Mother, Teen); |
| Destination : array (Family) of Location; |
| |
| -- Other type definitions and procedure declarations in real application. |
| |
| end CA13001_0; |
| |
| -- No bodies required for CA13001_0. |
| |
| --==================================================================-- |
| |
| -- Public parent. |
| |
| package CA13001_1 is |
| |
| type Transportation is (Bicycle, Clunker, New_Car); |
| type Key_Type is private; |
| Walking : boolean := false; |
| |
| -- Other type definitions and procedure declarations in real application. |
| |
| private |
| type Key_Type |
| is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car); |
| |
| end CA13001_1; |
| |
| -- No bodies required for CA13001_1. |
| |
| --==================================================================-- |
| |
| -- Private child. |
| |
| private package CA13001_1.CA13001_2 is |
| |
| type Transport is |
| record |
| In_Use : boolean := false; |
| end record; |
| Vehicles : array (Transportation) of Transport; |
| |
| -- Other type definitions and procedure declarations in real application. |
| |
| end CA13001_1.CA13001_2; |
| |
| -- No bodies required for CA13001_1.CA13001_2. |
| |
| --==================================================================-- |
| |
| -- Public grandchild of a private parent. |
| |
| package CA13001_1.CA13001_2.CA13001_3 is |
| |
| Flat_Tire : array (Transportation) of boolean := (others => false); |
| |
| -- Other type definitions and procedure declarations in real application. |
| |
| end 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. |
| |
| with CA13001_0; |
| use CA13001_0; |
| |
| -- Public grandchild of a private parent. |
| |
| package CA13001_1.CA13001_2.CA13001_4 is |
| |
| type Transit is |
| record |
| Available : boolean := false; |
| end record; |
| type Keys_Array is array (Transportation) of Transit; |
| Fuel : array (Transportation) of boolean := (others => true); |
| |
| protected Family_Transportation is |
| |
| procedure Get_Vehicle (Who : in Family; |
| Key : out Key_Type); |
| procedure Return_Vehicle (Tr : in Transportation); |
| function TC_Verify (What : Transportation) return boolean; |
| |
| private |
| Keys : Keys_Array; |
| |
| end Family_Transportation; |
| |
| end CA13001_1.CA13001_2.CA13001_4; |
| |
| --==================================================================-- |
| |
| -- Context clause required for visibility needed by a separate subunit. |
| |
| with CA13001_1.CA13001_2.CA13001_3; -- Public sibling. |
| |
| package body CA13001_1.CA13001_2.CA13001_4 is |
| |
| protected body Family_Transportation is separate; |
| |
| end CA13001_1.CA13001_2.CA13001_4; |
| |
| --==================================================================-- |
| |
| separate (CA13001_1.CA13001_2.CA13001_4) |
| protected body Family_Transportation is |
| |
| procedure Get_Vehicle (Who : in Family; |
| Key : out Key_Type) is |
| begin |
| case Who is |
| when Father|Mother => |
| -- Drive new car to work |
| |
| -- Reference package with'ed by the subunit parent's body. |
| if Destination(Who) = Work then |
| |
| -- Reference type declared in the private parent of the subunit |
| -- parent's body. |
| -- Reference type declared in the visible part of the |
| -- subunit parent's body. |
| if not Vehicles(New_Car).In_Use and Fuel(New_Car) |
| |
| -- Reference type declared in the public sibling of the |
| -- subunit parent's body. |
| and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then |
| Vehicles(New_Car).In_Use := true; |
| |
| -- Reference type declared in the private part of the |
| -- protected subunit. |
| Keys(New_Car).Available := false; |
| Key := Transportation'pos(New_Car); |
| else |
| -- Reference type declared in the grandparent of the subunit |
| -- parent's body. |
| Walking := true; |
| end if; |
| |
| -- Drive clunker to other destinations. |
| else |
| if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not |
| CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then |
| Vehicles(Clunker).In_Use := true; |
| Keys(Clunker).Available := false; |
| Key := Transportation'pos(Clunker); |
| else |
| Walking := true; |
| Key := Transportation'pos(Bicycle); |
| end if; |
| end if; |
| |
| -- Similar for Teen. |
| when Teen => |
| if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not |
| CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then |
| Vehicles(Clunker).In_Use := true; |
| Keys(Clunker).Available := false; |
| Key := Transportation'pos(Clunker); |
| else |
| Walking := true; |
| Key := Transportation'pos(Bicycle); |
| end if; |
| end case; |
| |
| end Get_Vehicle; |
| |
| ---------------------------------------------------------------- |
| |
| -- Any family member can bring back the transportation with the key. |
| |
| procedure Return_Vehicle (Tr : in Transportation) is |
| begin |
| Vehicles(Tr).In_Use := false; |
| Keys(Tr).Available := true; |
| end Return_Vehicle; |
| |
| ---------------------------------------------------------------- |
| |
| function TC_Verify (What : Transportation) return boolean is |
| begin |
| return Keys(What).Available; |
| end TC_Verify; |
| |
| end Family_Transportation; |
| |
| --==================================================================-- |
| |
| with CA13001_0; |
| use CA13001_0; |
| |
| -- Public child. |
| |
| package CA13001_1.CA13001_5 is |
| |
| -- In a real application, tasks could be used to demonstrate |
| -- a family transportation scenario, i.e., each member of |
| -- a family can take a vehicle out concurrently, then return |
| -- them at the same time. For the purposes of the test, family |
| -- transportation happens sequentially. |
| |
| procedure Provide_Transportation (Who : in Family; |
| Get_Key : out Key_Type; |
| Get_Veh : out boolean); |
| procedure Return_Transportation (What : in Transportation; |
| Rt_Veh : out boolean); |
| |
| end CA13001_1.CA13001_5; |
| |
| --==================================================================-- |
| |
| with CA13001_1.CA13001_2.CA13001_4; -- Public grandchild of a private parent, |
| -- implicitly with CA13001_1.CA13001_2. |
| package body CA13001_1.CA13001_5 is |
| |
| package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4; |
| use Transportation_Pkg; |
| |
| -- These two validation subprograms provide the capability to check the |
| -- components defined in the private packages from within the client |
| -- program. |
| |
| procedure Provide_Transportation (Who : in Family; |
| Get_Key : out Key_Type; |
| Get_Veh : out boolean) is |
| begin |
| -- Goto work, school, or to the beach. |
| Family_Transportation.Get_Vehicle (Who, Get_Key); |
| if not Family_Transportation.TC_Verify |
| (Transportation'Val(Get_Key)) then |
| Get_Veh := true; |
| else |
| Get_Veh := false; |
| end if; |
| |
| end Provide_Transportation; |
| |
| ---------------------------------------------------------------- |
| |
| procedure Return_Transportation (What : in Transportation; |
| Rt_Veh : out boolean) is |
| begin |
| Family_Transportation.Return_Vehicle (What); |
| if Family_Transportation.TC_Verify(What) and |
| not CA13001_1.CA13001_2.Vehicles(What).In_Use then |
| Rt_Veh := true; |
| else |
| Rt_Veh := false; |
| end if; |
| |
| end Return_Transportation; |
| |
| end CA13001_1.CA13001_5; |
| |
| --==================================================================-- |
| |
| with CA13001_0; |
| with CA13001_1.CA13001_5; -- Implicitly with parent, CA13001_1. |
| with Report; |
| |
| procedure CA13001 is |
| |
| Mommy : CA13001_0.Family := CA13001_0.Mother; |
| Daddy : CA13001_0.Family := CA13001_0.Father; |
| BG : CA13001_0.Family := CA13001_0.Teen; |
| BG_Clunker : CA13001_1.Transportation := CA13001_1.Clunker; |
| Get_Key : CA13001_1.Key_Type; |
| Get_Transit : boolean := false; |
| Return_Transit : boolean := false; |
| |
| begin |
| Report.Test ("CA13001", "Check that a protected subunit declared in " & |
| "a child unit of a private parent have the same visibility " & |
| "into its parent, its parent's siblings, and packages on " & |
| "which its parent depends"); |
| |
| -- Get transportation for mother to go to work. |
| CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work; |
| CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit); |
| if not Get_Transit then |
| Report.Failed ("Failed to get mother transportation"); |
| end if; |
| |
| -- Get transportation for teen to go to school. |
| CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School; |
| Get_Transit := false; |
| CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit); |
| if not Get_Transit then |
| Report.Failed ("Failed to get teen transportation"); |
| end if; |
| |
| -- Get transportation for father to go to the beach. |
| CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach; |
| Get_Transit := false; |
| CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit); |
| if Get_Transit and not CA13001_1.Walking then |
| Report.Failed ("Failed to make daddy to walk to the beach"); |
| end if; |
| |
| -- Return the clunker. |
| CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit); |
| if not Return_Transit then |
| Report.Failed ("Failed to get back the clunker"); |
| end if; |
| |
| Report.Result; |
| |
| end CA13001; |
