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