ca110051.am

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

-- CA110051.AM
--
--                             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 entities and operations declared in a package can be used
--      in the private part of a child of a child of the package.
--
-- TEST DESCRIPTION:
--      Declare a series of library unit packages -- parent, child, and 
--      grandchild.  The grandchild package will have a private part.
--      From within the private part of the grandchild, make use of 
--      components declared in the parent and grandparent packages.
--
-- TEST FILES:
--      The test consists of the following files:
--
--         CA110050.A
--      => CA110051.AM
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

                                    -- Grandchild Package Message.Text.Encoded
package CA110050_0.CA110050_1.CA110050_2 is  

   type Coded_Message is new Text_Message_Type with private;

   procedure Send (Message : in     Coded_Message;
                   Confirm :    out Coded_Message;
                   Status  :    out Boolean);

   function Encode (Message : Text_Message_Type) return Coded_Message;
   function Decode (Message : Coded_Message)     return Boolean;
   function Test_Connection                      return Boolean;

private

   Uncoded : Descriptor renames Null_Descriptor_Value; -- Grandparent object.

   type Coded_Message is new Text_Message_Type with    -- Parent type.
      record
         Key       : Descriptor := Uncoded;
         Coded_Key : Descriptor := Next_Available_Message;
                                 -- Grandparent type, grandparent function.
         Scrambled : Text_Type  := Null_Text;          -- Parent object.
      end record;                                      

   Coded_Msg : Coded_Message;

   type Blank_Message is new Message_Type with         -- Grandparent type.
      record
         ID        : Descriptor := Next_Available_Message;
                                 -- Grandparent type, grandparent function.
      end record;                                      

   Test_Message     : Blank_Message;

   Confirm_String   : constant String := "OK";
   Scrambled_String : constant String := "KO";

   Confirm_Text : Text_Type (Confirm_String'Length) :=
     (Max_Length => Confirm_String'Length,
      Length     => Confirm_String'Length,
      Text_Field => Confirm_String);

   Scrambled_Text : Text_Type (Scrambled_String'Length) :=
     (Max_Length => Scrambled_String'Length,
      Length     => Scrambled_String'Length,
      Text_Field => Scrambled_String);
     
end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded

     --=================================================================--

                               -- Grandchild Package body Message.Text.Encoded
package body CA110050_0.CA110050_1.CA110050_2 is 

   procedure Send (Message : in     Coded_Message;
                   Confirm :    out Coded_Message;
                   Status  :    out Boolean) is

      Confirmation_Message : Coded_Message :=
        (Number    => Message.Number,
         Text      => Confirm_Text,
         Key       => Message.Number,
         Coded_Key => Message.Number,
         Scrambled => Scrambled_Text);  

   begin                                          -- Dummy processing unit.
      Confirm := Confirmation_Message;
      if Confirm.Number /= Null_Message_Descriptor then
         Status := True;                            
      else
         Status := False;
      end if;
   end Send;
   -------------------------------------------------------------------------
   function Encode (Message : Text_Message_Type)  return Coded_Message is
   begin
      Coded_Msg.Number       := Message.Number;
      if Message.Text.Length > 0 then
         Coded_Msg.Text      := Message.Text;     -- Record assignment.
         Coded_Msg.Key       := Message.Number;   -- Same as msg number.
         Coded_Msg.Coded_Key := Message.Number;   -- Same as msg number.
         Coded_Msg.Scrambled := Message.Text;     -- Dummy processing.
      end if;
      return (Coded_Msg);
   end Encode;
   -------------------------------------------------------------------------
   function Decode (Message : Coded_Message) return Boolean is
      Decoded : Boolean := False;
   begin                                                       
      if (Message.Text.Length = Confirm_String'Length)        and then
         (Message.Text.Text_Field = Confirm_String)           and then
         (Message.Scrambled.Length = Scrambled_String'Length) and then
         (Message.Scrambled.Text_Field = Scrambled_String)    and then
         (Message.Coded_Key = 15)
      then
         Decoded := True;
      end if;
      return (Decoded);
   end Decode;
   -------------------------------------------------------------------------
   function Test_Connection return Boolean is
   begin
      return Test_Message.Id = 10;
   end Test_Connection;

end CA110050_0.CA110050_1.CA110050_2;        
                               -- Grandchild Package body Message.Text.Encoded
 
     --=================================================================--

with CA110050_0.CA110050_1.CA110050_2; 
with Report;

procedure CA110051 is

   package Message_Package renames CA110050_0.CA110050_1;
   package Code_Package    renames CA110050_0.CA110050_1.CA110050_2; 

   Message_String : constant String := "One if by land, two if by sea";

   Message_Text   : Message_Package.Text_Type (Message_String'Length) := 
     (Max_Length => Message_String'Length,
      Length     => Message_String'Length,
      Text_Field => Message_String);

   Message : Message_Package.Text_Message_Type := 
     (Number => CA110050_0.Next_Available_Message,
      Text   => Message_Text);

   Confirmation_Message : Code_Package.Coded_Message;
   Verification_OK      : Boolean := False;
   Transmission_OK      : Boolean := False;

begin

-- This test simulates the use of child library unit packages to implement
-- a message encoding and transmission scheme.  The full capability of the
-- encoding and transmission mechanisms are not developed here, but the 
-- intent is to demonstrate that a grandchild library unit package with a
-- private part will provide the framework for this type of processing.

   Report.Test ("CA110051", "Check that entities and operations declared "  &
                            "in a package can be used in the private part " & 
                            "of a child of a child of the package");

                            -- The following code demonstrates the use
                            -- of functionality contained in a grandchild
                            -- library unit.  The grandchild unit made use
                            -- of components declared in the ancestor
                            -- packages.
   
   Code_Package.Send                            -- Message object declared
     (Message => Code_Package.Encode (Message), -- above in "encoded" by a
      Confirm => Confirmation_Message,          -- call to grandchild pkg
      Status  => Transmission_OK);              -- function call, reseting
                                                -- fields and returning a
                                                -- coded message to the
                                                -- parameter.  The confirm
                                                -- parameter receives an
                                                -- encoded message value
                                                -- from proc Send, which is 
                                                -- "decoded"/verified below.

   if not Code_Package.Test_Connection then
      Report.Failed ("Bad initialization");
   end if;

   Verification_OK := Code_Package.Decode (Confirmation_Message);

   if not (Transmission_OK and Verification_OK) then
      Report.Failed ("Message transmission failure");
   end if;

   Report.Result;

end CA110051;