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
54package 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
68private
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
77end 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
85package 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
100end CA11017_0.CA11017_1;
101
102     --=================================================================--
103
104package 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
139end 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
147with CA11017_0.CA11017_1;
148
149package 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
172end CA11017_0;
173
174     --=================================================================--
175
176with Report;
177
178with CA11017_0.CA11017_1;   -- Explicit with public child package,
179                            -- implicit with parent package (CA11017_0).
180
181procedure CA11017 is
182
183   package String_Pkg renames CA11017_0;
184   use String_Pkg;
185
186begin
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
246end CA11017;
247