1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
-- CA11017.A
--
-- 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 body of the parent package may depend on one of its own
-- public children.
--
-- TEST DESCRIPTION:
-- A scenario is created that demonstrates the potential of adding a
-- public child during code maintenance without distubing a large
-- subsystem. After child is added to the subsystem, a maintainer
-- decides to take advantage of the new functionality and rewrites
-- the parent's body.
--
-- Declare a string abstraction in a package which manipulates string
-- replacement. Define a parent package which provides operations for
-- a record type with discriminant. Declare a public child of this
-- package which adds functionality to the original subsystem. In the
-- parent body, call operations from the public child.
--
-- In the main program, check that operations in the parent and public
-- child perform as expected.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
-- Simulates application which manipulates strings.
package CA11017_0 is
type String_Rec (The_Size : positive) is private;
type Substring is new string;
-- ... Various other types used by the application.
procedure Replace (In_The_String : in out String_Rec;
At_The_Position : in positive;
With_The_String : in String_Rec);
-- ... Various other operations used by the application.
private
-- Different size for each individual record.
type String_Rec (The_Size : positive) is
record
The_Length : natural := 0;
The_Content : Substring (1 .. The_Size);
end record;
end CA11017_0;
--=================================================================--
-- Public child added during code maintenance without disturbing a
-- large system. This public child would add functionality to the
-- original system.
package CA11017_0.CA11017_1 is
Position_Error : exception;
function Equal_Length (Left : in String_Rec;
Right : in String_Rec) return boolean;
function Same_Content (Left : in String_Rec;
Right : in String_Rec) return boolean;
procedure Copy (From_The_Substring : in Substring;
To_The_String : in out String_Rec);
-- ... Various other operations used by the application.
end CA11017_0.CA11017_1;
--=================================================================--
package body CA11017_0.CA11017_1 is
function Equal_Length (Left : in String_Rec;
Right : in String_Rec) return boolean is
-- Quick comparison between the lengths of the input strings.
begin
return (Left.The_Length = Right.The_Length); -- Parent's private
-- type.
end Equal_Length;
--------------------------------------------------------------------
function Same_Content (Left : in String_Rec;
Right : in String_Rec) return boolean is
begin
for I in 1 .. Left.The_Length loop
if Left.The_Content (I) = Right.The_Content (I) then
return true;
else
return false;
end if;
end loop;
end Same_Content;
--------------------------------------------------------------------
procedure Copy (From_The_Substring : in Substring;
To_The_String : in out String_Rec) is
begin
To_The_String.The_Content -- Parent's private type.
(1 .. From_The_Substring'length) := From_The_Substring;
To_The_String.The_Length -- Parent's private type.
:= From_The_Substring'length;
end Copy;
end CA11017_0.CA11017_1;
--=================================================================--
-- After child is added to the subsystem, a maintainer decides
-- to take advantage of the new functionality and rewrites the
-- parent's body.
with CA11017_0.CA11017_1;
package body CA11017_0 is
-- Calls functions from public child for a quick comparison of the
-- input strings. If their lengths are the same, do the replacement.
procedure Replace (In_The_String : in out String_Rec;
At_The_Position : in positive;
With_The_String : in String_Rec) is
End_Position : natural := At_The_Position +
With_The_String.The_Length - 1;
begin
if not CA11017_0.CA11017_1.Equal_Length -- Public child's operation.
(With_The_String, In_The_String) then
raise CA11017_0.CA11017_1.Position_Error;
-- Public child's exception.
else
In_The_String.The_Content (At_The_Position .. End_Position) :=
With_The_String.The_Content (1 .. With_The_String.The_Length);
end if;
end Replace;
end CA11017_0;
--=================================================================--
with Report;
with CA11017_0.CA11017_1; -- Explicit with public child package,
-- implicit with parent package (CA11017_0).
procedure CA11017 is
package String_Pkg renames CA11017_0;
use String_Pkg;
begin
Report.Test ("CA11017", "Check that body of the parent package can " &
"depend on one of its own public children");
-- Both input strings have the same size. Replace the first string by the
-- second string.
Replace_Subtest:
declare
The_First_String, The_Second_String : String_Rec (16);
-- Parent's private type.
The_Position : positive := 1;
begin
CA11017_1.Copy ("This is the time",
To_The_String => The_First_String);
CA11017_1.Copy ("For all good men", The_Second_String);
Replace (The_First_String, The_Position, The_Second_String);
-- Compare results using function from public child since
-- the type is private.
if not CA11017_1.Same_Content
(The_First_String, The_Second_String) then
Report.Failed ("Incorrect results");
end if;
end Replace_Subtest;
-- During processing, the application may erroneously attempt to replace
-- strings of different size. This would result in the raising of an
-- exception.
Exception_Subtest:
declare
The_First_String : String_Rec (17);
-- Parent's private type.
The_Second_String : String_Rec (13);
-- Parent's private type.
The_Position : positive := 2;
begin
CA11017_1.Copy (" ACVC Version 2.0", The_First_String);
CA11017_1.Copy (From_The_Substring => "ACVC 9X Basic",
To_The_String => The_Second_String);
Replace (The_First_String, The_Position, The_Second_String);
Report.Failed ("Exception was not raised");
exception
when CA11017_1.Position_Error =>
Report.Comment ("Exception is raised as expected");
end Exception_Subtest;
Report.Result;
end CA11017;
|
