1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
-- 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;
|
