Subversion Repositories openrisc_me

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