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