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