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