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
49package 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
61private
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
96end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded
97
98     --=================================================================--
99
100                               -- Grandchild Package body Message.Text.Encoded
101package 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
154end CA110050_0.CA110050_1.CA110050_2;
155                               -- Grandchild Package body Message.Text.Encoded
156
157     --=================================================================--
158
159with CA110050_0.CA110050_1.CA110050_2;
160with Report;
161
162procedure 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
182begin
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
224end CA110051;
225