ca11c03.a

来自「linux下编程用 编译软件」· A 代码 · 共 187 行

-- 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;