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