-- 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;