URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11c03.a] - Rev 867
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log