-- CA11C03.A
|
-- CA11C03.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that when a child unit is "withed", visibility is obtained to
|
-- Check that when a child unit is "withed", visibility is obtained to
|
-- all ancestor units named in the expanded name of the "withed" child
|
-- 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
|
-- unit. Check that when the parent unit is "used", the simple name of
|
-- a "withed" child unit is made directly visible.
|
-- a "withed" child unit is made directly visible.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- To satisfy the first part of the objective, various references are
|
-- To satisfy the first part of the objective, various references are
|
-- made to types and functions declared in the ancestor packages of the
|
-- made to types and functions declared in the ancestor packages of the
|
-- foundation code package hierarchy. Since the grandchild library unit
|
-- foundation code package hierarchy. Since the grandchild library unit
|
-- package has been "withed" by this test, the visibility of these
|
-- package has been "withed" by this test, the visibility of these
|
-- components demonstrates that visibility of the ancestor package names
|
-- components demonstrates that visibility of the ancestor package names
|
-- is provided when the expanded name of a child library unit is "withed".
|
-- 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
|
-- The declare block in the test program includes a "use" clause of the
|
-- parent package (FA11C00_0.FA11C00_1) of the "withed" child package.
|
-- parent package (FA11C00_0.FA11C00_1) of the "withed" child package.
|
-- As a result, the simple name of the child package (FA11C00_2) is
|
-- As a result, the simple name of the child package (FA11C00_2) is
|
-- directly visible. The type and function declared in the child
|
-- directly visible. The type and function declared in the child
|
-- package are now visible when qualified with the simple name of the
|
-- package are now visible when qualified with the simple name of the
|
-- "withed" package (FA11C00_2).
|
-- "withed" package (FA11C00_2).
|
--
|
--
|
-- This test simulates the formatting of data strings, based on the
|
-- This test simulates the formatting of data strings, based on the
|
-- component fields of a "doubly-extended" tagged record type.
|
-- component fields of a "doubly-extended" tagged record type.
|
--
|
--
|
-- TEST FILES:
|
-- TEST FILES:
|
-- This test depends on the following foundation code:
|
-- This test depends on the following foundation code:
|
--
|
--
|
-- FA11C00.A
|
-- FA11C00.A
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
--
|
--
|
--!
|
--!
|
|
|
with FA11C00_0.FA11C00_1.FA11C00_2; -- "with" of child library package
|
with FA11C00_0.FA11C00_1.FA11C00_2; -- "with" of child library package
|
-- Animal.Mammal.Primate.
|
-- Animal.Mammal.Primate.
|
-- This will be used in conjunction with
|
-- This will be used in conjunction with
|
-- a "use" of FA11C00_0.FA11C00_1 below
|
-- a "use" of FA11C00_0.FA11C00_1 below
|
-- to verify a portion of the objective.
|
-- to verify a portion of the objective.
|
with Report;
|
with Report;
|
|
|
procedure CA11C03 is
|
procedure CA11C03 is
|
|
|
Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' ');
|
Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' ');
|
-- Visibility of grandparent package.
|
-- Visibility of grandparent package.
|
-- The package FA11C00_0 is visible since
|
-- The package FA11C00_0 is visible since
|
-- it is an ancestor that is mentioned in
|
-- it is an ancestor that is mentioned in
|
-- the expanded name of its "withed"
|
-- the expanded name of its "withed"
|
-- grandchild package.
|
-- grandchild package.
|
|
|
Blank_Hair_Color :
|
Blank_Hair_Color :
|
String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' ');
|
String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' ');
|
-- Visibility of parent package.
|
-- Visibility of parent package.
|
-- The package FA11C00_0.FA11C00_1 is
|
-- The package FA11C00_0.FA11C00_1 is
|
-- visible due to the "with" of its
|
-- visible due to the "with" of its
|
-- child package.
|
-- child package.
|
|
|
subtype Data_String_Type is String (1 .. 60);
|
subtype Data_String_Type is String (1 .. 60);
|
|
|
TC_Result_String : Data_String_Type := (others => ' ');
|
TC_Result_String : Data_String_Type := (others => ' ');
|
|
|
--
|
--
|
|
|
function Format_Primate_Data (Name : String := Blank_Name_String;
|
function Format_Primate_Data (Name : String := Blank_Name_String;
|
Hair : String := Blank_Hair_Color)
|
Hair : String := Blank_Hair_Color)
|
return Data_String_Type is
|
return Data_String_Type is
|
|
|
Pos : Integer := 1;
|
Pos : Integer := 1;
|
Hair_Color_Field_Separator : constant String := " Hair Color: ";
|
Hair_Color_Field_Separator : constant String := " Hair Color: ";
|
|
|
Result_String : Data_String_Type := (others => ' ');
|
Result_String : Data_String_Type := (others => ' ');
|
|
|
begin
|
begin
|
Result_String (Pos .. Name'Length) := Name; -- Enter name at start
|
Result_String (Pos .. Name'Length) := Name; -- Enter name at start
|
-- of string.
|
-- of string.
|
Pos := Pos + Name'Length; -- Increment counter to
|
Pos := Pos + Name'Length; -- Increment counter to
|
-- next blank position.
|
-- next blank position.
|
Result_String
|
Result_String
|
(Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) :=
|
(Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) :=
|
Hair_Color_Field_Separator & Hair; -- Include hair color data
|
Hair_Color_Field_Separator & Hair; -- Include hair color data
|
-- in result string.
|
-- in result string.
|
return (Result_String);
|
return (Result_String);
|
end Format_Primate_Data;
|
end Format_Primate_Data;
|
|
|
|
|
begin
|
begin
|
|
|
Report.Test ("CA11C03", "Check that when a child unit is WITHED, " &
|
Report.Test ("CA11C03", "Check that when a child unit is WITHED, " &
|
"visibility is obtained to all ancestor units " &
|
"visibility is obtained to all ancestor units " &
|
"named in the expanded name of the WITHED child " &
|
"named in the expanded name of the WITHED child " &
|
"unit. Check that when the parent unit is USED, " &
|
"unit. Check that when the parent unit is USED, " &
|
"the simple name of a WITHED child unit is made " &
|
"the simple name of a WITHED child unit is made " &
|
"directly visible" );
|
"directly visible" );
|
|
|
declare
|
declare
|
use FA11C00_0.FA11C00_1; -- This "use" clause will allow direct
|
use FA11C00_0.FA11C00_1; -- This "use" clause will allow direct
|
-- visibility to the simple name of
|
-- visibility to the simple name of
|
-- package FA11C00_0.FA11C00_1.FA11C00_2,
|
-- package FA11C00_0.FA11C00_1.FA11C00_2,
|
-- since this child package was "withed" by
|
-- since this child package was "withed" by
|
-- the main program.
|
-- the main program.
|
|
|
Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ",
|
Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ",
|
Weight => 7,
|
Weight => 7,
|
Hair_Color => Brown,
|
Hair_Color => Brown,
|
Habitat => FA11C00_2.Arboreal);
|
Habitat => FA11C00_2.Arboreal);
|
|
|
-- Demonstrates visibility of package
|
-- Demonstrates visibility of package
|
-- FA11C00_0.FA11C00_1.FA11C00_2.
|
-- FA11C00_0.FA11C00_1.FA11C00_2.
|
--
|
--
|
-- Type Primate referenced with the simple
|
-- Type Primate referenced with the simple
|
-- name of package FA11C00_2 only.
|
-- name of package FA11C00_2 only.
|
--
|
--
|
-- Simple name of package FA11C00_2 is
|
-- Simple name of package FA11C00_2 is
|
-- directly visible through "use" of parent.
|
-- directly visible through "use" of parent.
|
|
|
begin
|
begin
|
|
|
-- Verify that the Format_Primate_Data function will return a blank
|
-- Verify that the Format_Primate_Data function will return a blank
|
-- filled string when no parameters are provided in the call.
|
-- filled string when no parameters are provided in the call.
|
|
|
TC_Result_String := Format_Primate_Data;
|
TC_Result_String := Format_Primate_Data;
|
|
|
if (TC_Result_String (1 .. 20) /= Blank_Name_String) then
|
if (TC_Result_String (1 .. 20) /= Blank_Name_String) then
|
Report.Failed ("Incorrect initialization value from function");
|
Report.Failed ("Incorrect initialization value from function");
|
end if;
|
end if;
|
|
|
|
|
-- Use function Format_Primate_Data to return a formatted data string.
|
-- Use function Format_Primate_Data to return a formatted data string.
|
|
|
TC_Result_String :=
|
TC_Result_String :=
|
Format_Primate_Data
|
Format_Primate_Data
|
(Name => FA11C00_2.Image (Tarsier),
|
(Name => FA11C00_2.Image (Tarsier),
|
-- Function returns a 37 character string
|
-- Function returns a 37 character string
|
-- value.
|
-- value.
|
Hair => Hair_Color_Type'Image(Tarsier.Hair_Color));
|
Hair => Hair_Color_Type'Image(Tarsier.Hair_Color));
|
-- The Hair_Color_Type is referenced
|
-- The Hair_Color_Type is referenced
|
-- directly, without package
|
-- directly, without package
|
-- FA11C00_0.FA11C00_1 qualifier.
|
-- FA11C00_0.FA11C00_1 qualifier.
|
-- No qualification of Hair_Color_Type is
|
-- No qualification of Hair_Color_Type is
|
-- needed due to "use" clause.
|
-- needed due to "use" clause.
|
|
|
-- Note that the result of calling 'Image
|
-- Note that the result of calling 'Image
|
-- with an enumeration type argument
|
-- with an enumeration type argument
|
-- results in an upper-case string.
|
-- results in an upper-case string.
|
-- (See conditional statement below.)
|
-- (See conditional statement below.)
|
|
|
-- Verify the results of the function call.
|
-- Verify the results of the function call.
|
|
|
if not (TC_Result_String (1 .. 37) =
|
if not (TC_Result_String (1 .. 37) =
|
"Primate Species: East-Indian Tarsier " and then
|
"Primate Species: East-Indian Tarsier " and then
|
TC_Result_String (38 .. 55) =
|
TC_Result_String (38 .. 55) =
|
" Hair Color: BROWN") then
|
" Hair Color: BROWN") then
|
Report.Failed ("Incorrect result returned from function call");
|
Report.Failed ("Incorrect result returned from function call");
|
end if;
|
end if;
|
|
|
end;
|
end;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CA11C03;
|
end CA11C03;
|
|
|
