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