-- CA11C03.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 when a child unit is "withed", visibility is obtained to -- all ancestor units named in the expanded name of the "withed" child -- unit. Check that when the parent unit is "used", the simple name of -- a "withed" child unit is made directly visible. -- -- TEST DESCRIPTION: -- To satisfy the first part of the objective, various references are -- made to types and functions declared in the ancestor packages of the -- foundation code package hierarchy. Since the grandchild library unit -- package has been "withed" by this test, the visibility of these -- components demonstrates that visibility of the ancestor package names -- is provided when the expanded name of a child library unit is "withed". -- -- The declare block in the test program includes a "use" clause of the -- parent package (FA11C00_0.FA11C00_1) of the "withed" child package. -- As a result, the simple name of the child package (FA11C00_2) is -- directly visible. The type and function declared in the child -- package are now visible when qualified with the simple name of the -- "withed" package (FA11C00_2). -- -- This test simulates the formatting of data strings, based on the -- component fields of a "doubly-extended" tagged record type. -- -- TEST FILES: -- This test depends on the following foundation code: -- -- FA11C00.A -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! with FA11C00_0.FA11C00_1.FA11C00_2; -- "with" of child library package -- Animal.Mammal.Primate. -- This will be used in conjunction with -- a "use" of FA11C00_0.FA11C00_1 below -- to verify a portion of the objective. with Report; procedure CA11C03 is Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' '); -- Visibility of grandparent package. -- The package FA11C00_0 is visible since -- it is an ancestor that is mentioned in -- the expanded name of its "withed" -- grandchild package. Blank_Hair_Color : String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' '); -- Visibility of parent package. -- The package FA11C00_0.FA11C00_1 is -- visible due to the "with" of its -- child package. subtype Data_String_Type is String (1 .. 60); TC_Result_String : Data_String_Type := (others => ' '); -- function Format_Primate_Data (Name : String := Blank_Name_String; Hair : String := Blank_Hair_Color) return Data_String_Type is Pos : Integer := 1; Hair_Color_Field_Separator : constant String := " Hair Color: "; Result_String : Data_String_Type := (others => ' '); begin Result_String (Pos .. Name'Length) := Name; -- Enter name at start -- of string. Pos := Pos + Name'Length; -- Increment counter to -- next blank position. Result_String (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) := Hair_Color_Field_Separator & Hair; -- Include hair color data -- in result string. return (Result_String); end Format_Primate_Data; begin Report.Test ("CA11C03", "Check that when a child unit is WITHED, " & "visibility is obtained to all ancestor units " & "named in the expanded name of the WITHED child " & "unit. Check that when the parent unit is USED, " & "the simple name of a WITHED child unit is made " & "directly visible" ); declare use FA11C00_0.FA11C00_1; -- This "use" clause will allow direct -- visibility to the simple name of -- package FA11C00_0.FA11C00_1.FA11C00_2, -- since this child package was "withed" by -- the main program. Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ", Weight => 7, Hair_Color => Brown, Habitat => FA11C00_2.Arboreal); -- Demonstrates visibility of package -- FA11C00_0.FA11C00_1.FA11C00_2. -- -- Type Primate referenced with the simple -- name of package FA11C00_2 only. -- -- Simple name of package FA11C00_2 is -- directly visible through "use" of parent. begin -- Verify that the Format_Primate_Data function will return a blank -- filled string when no parameters are provided in the call. TC_Result_String := Format_Primate_Data; if (TC_Result_String (1 .. 20) /= Blank_Name_String) then Report.Failed ("Incorrect initialization value from function"); end if; -- Use function Format_Primate_Data to return a formatted data string. TC_Result_String := Format_Primate_Data (Name => FA11C00_2.Image (Tarsier), -- Function returns a 37 character string -- value. Hair => Hair_Color_Type'Image(Tarsier.Hair_Color)); -- The Hair_Color_Type is referenced -- directly, without package -- FA11C00_0.FA11C00_1 qualifier. -- No qualification of Hair_Color_Type is -- needed due to "use" clause. -- Note that the result of calling 'Image -- with an enumeration type argument -- results in an upper-case string. -- (See conditional statement below.) -- Verify the results of the function call. if not (TC_Result_String (1 .. 37) = "Primate Species: East-Indian Tarsier " and then TC_Result_String (38 .. 55) = " Hair Color: BROWN") then Report.Failed ("Incorrect result returned from function call"); end if; end; Report.Result; end CA11C03;