1-- CA11C03.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- 26-- OBJECTIVE: 27-- Check that when a child unit is "withed", visibility is obtained to 28-- all ancestor units named in the expanded name of the "withed" child 29-- unit. Check that when the parent unit is "used", the simple name of 30-- a "withed" child unit is made directly visible. 31-- 32-- TEST DESCRIPTION: 33-- To satisfy the first part of the objective, various references are 34-- made to types and functions declared in the ancestor packages of the 35-- foundation code package hierarchy. Since the grandchild library unit 36-- package has been "withed" by this test, the visibility of these 37-- components demonstrates that visibility of the ancestor package names 38-- is provided when the expanded name of a child library unit is "withed". 39-- 40-- The declare block in the test program includes a "use" clause of the 41-- parent package (FA11C00_0.FA11C00_1) of the "withed" child package. 42-- As a result, the simple name of the child package (FA11C00_2) is 43-- directly visible. The type and function declared in the child 44-- package are now visible when qualified with the simple name of the 45-- "withed" package (FA11C00_2). 46-- 47-- This test simulates the formatting of data strings, based on the 48-- component fields of a "doubly-extended" tagged record type. 49-- 50-- TEST FILES: 51-- This test depends on the following foundation code: 52-- 53-- FA11C00.A 54-- 55-- 56-- CHANGE HISTORY: 57-- 06 Dec 94 SAIC ACVC 2.0 58-- 59--! 60 61with FA11C00_0.FA11C00_1.FA11C00_2; -- "with" of child library package 62 -- Animal.Mammal.Primate. 63 -- This will be used in conjunction with 64 -- a "use" of FA11C00_0.FA11C00_1 below 65 -- to verify a portion of the objective. 66with Report; 67 68procedure CA11C03 is 69 70 Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' '); 71 -- Visibility of grandparent package. 72 -- The package FA11C00_0 is visible since 73 -- it is an ancestor that is mentioned in 74 -- the expanded name of its "withed" 75 -- grandchild package. 76 77 Blank_Hair_Color : 78 String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' '); 79 -- Visibility of parent package. 80 -- The package FA11C00_0.FA11C00_1 is 81 -- visible due to the "with" of its 82 -- child package. 83 84 subtype Data_String_Type is String (1 .. 60); 85 86 TC_Result_String : Data_String_Type := (others => ' '); 87 88 -- 89 90 function Format_Primate_Data (Name : String := Blank_Name_String; 91 Hair : String := Blank_Hair_Color) 92 return Data_String_Type is 93 94 Pos : Integer := 1; 95 Hair_Color_Field_Separator : constant String := " Hair Color: "; 96 97 Result_String : Data_String_Type := (others => ' '); 98 99 begin 100 Result_String (Pos .. Name'Length) := Name; -- Enter name at start 101 -- of string. 102 Pos := Pos + Name'Length; -- Increment counter to 103 -- next blank position. 104 Result_String 105 (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) := 106 Hair_Color_Field_Separator & Hair; -- Include hair color data 107 -- in result string. 108 return (Result_String); 109 end Format_Primate_Data; 110 111 112begin 113 114 Report.Test ("CA11C03", "Check that when a child unit is WITHED, " & 115 "visibility is obtained to all ancestor units " & 116 "named in the expanded name of the WITHED child " & 117 "unit. Check that when the parent unit is USED, " & 118 "the simple name of a WITHED child unit is made " & 119 "directly visible" ); 120 121 declare 122 use FA11C00_0.FA11C00_1; -- This "use" clause will allow direct 123 -- visibility to the simple name of 124 -- package FA11C00_0.FA11C00_1.FA11C00_2, 125 -- since this child package was "withed" by 126 -- the main program. 127 128 Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ", 129 Weight => 7, 130 Hair_Color => Brown, 131 Habitat => FA11C00_2.Arboreal); 132 133 -- Demonstrates visibility of package 134 -- FA11C00_0.FA11C00_1.FA11C00_2. 135 -- 136 -- Type Primate referenced with the simple 137 -- name of package FA11C00_2 only. 138 -- 139 -- Simple name of package FA11C00_2 is 140 -- directly visible through "use" of parent. 141 142 begin 143 144 -- Verify that the Format_Primate_Data function will return a blank 145 -- filled string when no parameters are provided in the call. 146 147 TC_Result_String := Format_Primate_Data; 148 149 if (TC_Result_String (1 .. 20) /= Blank_Name_String) then 150 Report.Failed ("Incorrect initialization value from function"); 151 end if; 152 153 154 -- Use function Format_Primate_Data to return a formatted data string. 155 156 TC_Result_String := 157 Format_Primate_Data 158 (Name => FA11C00_2.Image (Tarsier), 159 -- Function returns a 37 character string 160 -- value. 161 Hair => Hair_Color_Type'Image(Tarsier.Hair_Color)); 162 -- The Hair_Color_Type is referenced 163 -- directly, without package 164 -- FA11C00_0.FA11C00_1 qualifier. 165 -- No qualification of Hair_Color_Type is 166 -- needed due to "use" clause. 167 168 -- Note that the result of calling 'Image 169 -- with an enumeration type argument 170 -- results in an upper-case string. 171 -- (See conditional statement below.) 172 173 -- Verify the results of the function call. 174 175 if not (TC_Result_String (1 .. 37) = 176 "Primate Species: East-Indian Tarsier " and then 177 TC_Result_String (38 .. 55) = 178 " Hair Color: BROWN") then 179 Report.Failed ("Incorrect result returned from function call"); 180 end if; 181 182 end; 183 184 Report.Result; 185 186end CA11C03; 187