3 -- Grant of Unlimited Rights
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
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.
27 -- Check that body of the parent package may depend on one of its own
31 -- A scenario is created that demonstrates the potential of adding a
32 -- public child during code maintenance without distubing a large
33 -- subsystem. After child is added to the subsystem, a maintainer
34 -- decides to take advantage of the new functionality and rewrites
37 -- Declare a string abstraction in a package which manipulates string
38 -- replacement. Define a parent package which provides operations for
39 -- a record type with discriminant. Declare a public child of this
40 -- package which adds functionality to the original subsystem. In the
41 -- parent body, call operations from the public child.
43 -- In the main program, check that operations in the parent and public
44 -- child perform as expected.
48 -- 06 Dec 94 SAIC ACVC 2.0
52 -- Simulates application which manipulates strings.
56 type String_Rec
(The_Size
: positive) is private;
58 type Substring
is new string;
60 -- ... Various other types used by the application.
62 procedure Replace
(In_The_String
: in out String_Rec
;
63 At_The_Position
: in positive;
64 With_The_String
: in String_Rec
);
66 -- ... Various other operations used by the application.
69 -- Different size for each individual record.
71 type String_Rec
(The_Size
: positive) is
73 The_Length
: natural := 0;
74 The_Content
: Substring
(1 .. The_Size
);
79 --=================================================================--
81 -- Public child added during code maintenance without disturbing a
82 -- large system. This public child would add functionality to the
85 package CA11017_0
.CA11017_1
is
87 Position_Error
: exception;
89 function Equal_Length
(Left
: in String_Rec
;
90 Right
: in String_Rec
) return boolean;
92 function Same_Content
(Left
: in String_Rec
;
93 Right
: in String_Rec
) return boolean;
95 procedure Copy
(From_The_Substring
: in Substring
;
96 To_The_String
: in out String_Rec
);
98 -- ... Various other operations used by the application.
100 end CA11017_0
.CA11017_1
;
102 --=================================================================--
104 package body CA11017_0
.CA11017_1
is
106 function Equal_Length
(Left
: in String_Rec
;
107 Right
: in String_Rec
) return boolean is
108 -- Quick comparison between the lengths of the input strings.
111 return (Left
.The_Length
= Right
.The_Length
); -- Parent's private
114 --------------------------------------------------------------------
115 function Same_Content
(Left
: in String_Rec
;
116 Right
: in String_Rec
) return boolean is
119 for I
in 1 .. Left
.The_Length
loop
120 if Left
.The_Content
(I
) = Right
.The_Content
(I
) then
128 --------------------------------------------------------------------
129 procedure Copy
(From_The_Substring
: in Substring
;
130 To_The_String
: in out String_Rec
) is
132 To_The_String
.The_Content
-- Parent's private type.
133 (1 .. From_The_Substring
'length) := From_The_Substring
;
135 To_The_String
.The_Length
-- Parent's private type.
136 := From_The_Substring
'length;
139 end CA11017_0
.CA11017_1
;
141 --=================================================================--
143 -- After child is added to the subsystem, a maintainer decides
144 -- to take advantage of the new functionality and rewrites the
147 with CA11017_0
.CA11017_1
;
149 package body CA11017_0
is
151 -- Calls functions from public child for a quick comparison of the
152 -- input strings. If their lengths are the same, do the replacement.
154 procedure Replace
(In_The_String
: in out String_Rec
;
155 At_The_Position
: in positive;
156 With_The_String
: in String_Rec
) is
157 End_Position
: natural := At_The_Position
+
158 With_The_String
.The_Length
- 1;
161 if not CA11017_0
.CA11017_1
.Equal_Length
-- Public child's operation.
162 (With_The_String
, In_The_String
) then
163 raise CA11017_0
.CA11017_1
.Position_Error
;
164 -- Public child's exception.
166 In_The_String
.The_Content
(At_The_Position
.. End_Position
) :=
167 With_The_String
.The_Content
(1 .. With_The_String
.The_Length
);
174 --=================================================================--
178 with CA11017_0
.CA11017_1
; -- Explicit with public child package,
179 -- implicit with parent package (CA11017_0).
183 package String_Pkg
renames CA11017_0
;
188 Report
.Test
("CA11017", "Check that body of the parent package can " &
189 "depend on one of its own public children");
191 -- Both input strings have the same size. Replace the first string by the
196 The_First_String
, The_Second_String
: String_Rec
(16);
197 -- Parent's private type.
198 The_Position
: positive := 1;
200 CA11017_1
.Copy
("This is the time",
201 To_The_String
=> The_First_String
);
203 CA11017_1
.Copy
("For all good men", The_Second_String
);
205 Replace
(The_First_String
, The_Position
, The_Second_String
);
207 -- Compare results using function from public child since
208 -- the type is private.
210 if not CA11017_1
.Same_Content
211 (The_First_String
, The_Second_String
) then
212 Report
.Failed
("Incorrect results");
217 -- During processing, the application may erroneously attempt to replace
218 -- strings of different size. This would result in the raising of an
223 The_First_String
: String_Rec
(17);
224 -- Parent's private type.
225 The_Second_String
: String_Rec
(13);
226 -- Parent's private type.
227 The_Position
: positive := 2;
229 CA11017_1
.Copy
(" ACVC Version 2.0", The_First_String
);
231 CA11017_1
.Copy
(From_The_Substring
=> "ACVC 9X Basic",
232 To_The_String
=> The_Second_String
);
234 Replace
(The_First_String
, The_Position
, The_Second_String
);
236 Report
.Failed
("Exception was not raised");
239 when CA11017_1
.Position_Error
=>
240 Report
.Comment
("Exception is raised as expected");
242 end Exception_Subtest
;