gomp-20050608-branch/gcc/testsuite/ada/acats/tests/ca/ca110051.am

   1 -- CA110051.AM
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that entities and operations declared in a package can be used
  28 --      in the private part of a child of a child of the package.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a series of library unit packages -- parent, child, and
  32 --      grandchild.  The grandchild package will have a private part.
  33 --      From within the private part of the grandchild, make use of
  34 --      components declared in the parent and grandparent packages.
  35 --
  36 -- TEST FILES:
  37 --      The test consists of the following files:
  38 --
  39 --         CA110050.A
  40 --      => CA110051.AM
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      06 Dec 94   SAIC    ACVC 2.0
  45 --
  46 --!
  47
  48                                     -- Grandchild Package Message.Text.Encoded
  49 package CA110050_0.CA110050_1.CA110050_2 is
  50
  51    type Coded_Message is new Text_Message_Type with private;
  52
  53    procedure Send (Message : in     Coded_Message;
  54                    Confirm :    out Coded_Message;
  55                    Status  :    out Boolean);
  56
  57    function Encode (Message : Text_Message_Type) return Coded_Message;
  58    function Decode (Message : Coded_Message)     return Boolean;
  59    function Test_Connection                      return Boolean;
  60
  61 private
  62
  63    Uncoded : Descriptor renames Null_Descriptor_Value; -- Grandparent object.
  64
  65    type Coded_Message is new Text_Message_Type with    -- Parent type.
  66       record
  67          Key       : Descriptor := Uncoded;
  68          Coded_Key : Descriptor := Next_Available_Message;
  69                                  -- Grandparent type, grandparent function.
  70          Scrambled : Text_Type  := Null_Text;          -- Parent object.
  71       end record;
  72
  73    Coded_Msg : Coded_Message;
  74
  75    type Blank_Message is new Message_Type with         -- Grandparent type.
  76       record
  77          ID        : Descriptor := Next_Available_Message;
  78                                  -- Grandparent type, grandparent function.
  79       end record;
  80
  81    Test_Message     : Blank_Message;
  82
  83    Confirm_String   : constant String := "OK";
  84    Scrambled_String : constant String := "KO";
  85
  86    Confirm_Text : Text_Type (Confirm_String'Length) :=
  87      (Max_Length => Confirm_String'Length,
  88       Length     => Confirm_String'Length,
  89       Text_Field => Confirm_String);
  90
  91    Scrambled_Text : Text_Type (Scrambled_String'Length) :=
  92      (Max_Length => Scrambled_String'Length,
  93       Length     => Scrambled_String'Length,
  94       Text_Field => Scrambled_String);
  95
  96 end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded
  97
  98      --=================================================================--
  99
 100                                -- Grandchild Package body Message.Text.Encoded
 101 package body CA110050_0.CA110050_1.CA110050_2 is
 102
 103    procedure Send (Message : in     Coded_Message;
 104                    Confirm :    out Coded_Message;
 105                    Status  :    out Boolean) is
 106
 107       Confirmation_Message : Coded_Message :=
 108         (Number    => Message.Number,
 109          Text      => Confirm_Text,
 110          Key       => Message.Number,
 111          Coded_Key => Message.Number,
 112          Scrambled => Scrambled_Text);
 113
 114    begin                                          -- Dummy processing unit.
 115       Confirm := Confirmation_Message;
 116       if Confirm.Number /= Null_Message_Descriptor then
 117          Status := True;
 118       else
 119          Status := False;
 120       end if;
 121    end Send;
 122    -------------------------------------------------------------------------
 123    function Encode (Message : Text_Message_Type)  return Coded_Message is
 124    begin
 125       Coded_Msg.Number       := Message.Number;
 126       if Message.Text.Length > 0 then
 127          Coded_Msg.Text      := Message.Text;     -- Record assignment.
 128          Coded_Msg.Key       := Message.Number;   -- Same as msg number.
 129          Coded_Msg.Coded_Key := Message.Number;   -- Same as msg number.
 130          Coded_Msg.Scrambled := Message.Text;     -- Dummy processing.
 131       end if;
 132       return (Coded_Msg);
 133    end Encode;
 134    -------------------------------------------------------------------------
 135    function Decode (Message : Coded_Message) return Boolean is
 136       Decoded : Boolean := False;
 137    begin
 138       if (Message.Text.Length = Confirm_String'Length)        and then
 139          (Message.Text.Text_Field = Confirm_String)           and then
 140          (Message.Scrambled.Length = Scrambled_String'Length) and then
 141          (Message.Scrambled.Text_Field = Scrambled_String)    and then
 142          (Message.Coded_Key = 15)
 143       then
 144          Decoded := True;
 145       end if;
 146       return (Decoded);
 147    end Decode;
 148    -------------------------------------------------------------------------
 149    function Test_Connection return Boolean is
 150    begin
 151       return Test_Message.Id = 10;
 152    end Test_Connection;
 153
 154 end CA110050_0.CA110050_1.CA110050_2;
 155                                -- Grandchild Package body Message.Text.Encoded
 156
 157      --=================================================================--
 158
 159 with CA110050_0.CA110050_1.CA110050_2;
 160 with Report;
 161
 162 procedure CA110051 is
 163
 164    package Message_Package renames CA110050_0.CA110050_1;
 165    package Code_Package    renames CA110050_0.CA110050_1.CA110050_2;
 166
 167    Message_String : constant String := "One if by land, two if by sea";
 168
 169    Message_Text   : Message_Package.Text_Type (Message_String'Length) :=
 170      (Max_Length => Message_String'Length,
 171       Length     => Message_String'Length,
 172       Text_Field => Message_String);
 173
 174    Message : Message_Package.Text_Message_Type :=
 175      (Number => CA110050_0.Next_Available_Message,
 176       Text   => Message_Text);
 177
 178    Confirmation_Message : Code_Package.Coded_Message;
 179    Verification_OK      : Boolean := False;
 180    Transmission_OK      : Boolean := False;
 181
 182 begin
 183
 184 -- This test simulates the use of child library unit packages to implement
 185 -- a message encoding and transmission scheme.  The full capability of the
 186 -- encoding and transmission mechanisms are not developed here, but the
 187 -- intent is to demonstrate that a grandchild library unit package with a
 188 -- private part will provide the framework for this type of processing.
 189
 190    Report.Test ("CA110051", "Check that entities and operations declared "  &
 191                             "in a package can be used in the private part " &
 192                             "of a child of a child of the package");
 193
 194                             -- The following code demonstrates the use
 195                             -- of functionality contained in a grandchild
 196                             -- library unit.  The grandchild unit made use
 197                             -- of components declared in the ancestor
 198                             -- packages.
 199
 200    Code_Package.Send                            -- Message object declared
 201      (Message => Code_Package.Encode (Message), -- above in "encoded" by a
 202       Confirm => Confirmation_Message,          -- call to grandchild pkg
 203       Status  => Transmission_OK);              -- function call, reseting
 204                                                 -- fields and returning a
 205                                                 -- coded message to the
 206                                                 -- parameter.  The confirm
 207                                                 -- parameter receives an
 208                                                 -- encoded message value
 209                                                 -- from proc Send, which is
 210                                                 -- "decoded"/verified below.
 211
 212    if not Code_Package.Test_Connection then
 213       Report.Failed ("Bad initialization");
 214    end if;
 215
 216    Verification_OK := Code_Package.Decode (Confirmation_Message);
 217
 218    if not (Transmission_OK and Verification_OK) then
 219       Report.Failed ("Message transmission failure");
 220    end if;
 221
 222    Report.Result;
 223
 224 end CA110051;