| -- CA11020.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 generic parent package can depend on one of |
| -- its own public generic children. |
| -- |
| -- TEST DESCRIPTION: |
| -- A scenario is created that demonstrates the potential of adding a |
| -- public generic 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 bag abstraction in a generic package. Declare a public |
| -- generic child of this package which adds a generic procedure to the |
| -- original subsystem. In the parent body, instantiate the public |
| -- child. Then instantiate the procedure as a child instance of the |
| -- public child instance. |
| -- |
| -- In the main program, declare an instance of parent. Check that the |
| -- operations in both parent and child packages perform as expected. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| -- Simulates bag application. |
| |
| generic |
| type Element is private; |
| with function Image (E : Element) return String; |
| |
| package CA11020_0 is |
| |
| type Bag is limited private; |
| |
| procedure Add (E : in Element; To_The_Bag : in out Bag); |
| |
| function Bag_Image (B : Bag) return string; |
| |
| private |
| type Node_Type; |
| type Bag is access Node_Type; |
| |
| type Node_Type is |
| record |
| The_Element : Element; |
| |
| -- Other components in real application, i.e., |
| -- The_Count : positive; |
| |
| Next : Bag; |
| end record; |
| |
| end CA11020_0; |
| |
| --==================================================================-- |
| |
| -- More operations on Bag. |
| |
| generic |
| |
| -- Parameters go here. |
| |
| package CA11020_0.CA11020_1 is |
| |
| -- ... Other declarations. |
| |
| generic -- Generic iterator procedure. |
| with procedure Use_Element (E : in Element); |
| |
| procedure Iterate (B : in Bag); -- Called once per element in the bag. |
| |
| -- ... Various other operations. |
| |
| end CA11020_0.CA11020_1; |
| |
| --==================================================================-- |
| |
| package body CA11020_0.CA11020_1 is |
| |
| procedure Iterate (B : in Bag) is |
| |
| -- Traverse each element in the bag. |
| |
| Elem : Bag := B; |
| |
| begin |
| while Elem /= null loop |
| Use_Element (Elem.The_Element); |
| Elem := Elem.Next; |
| end loop; |
| |
| end Iterate; |
| |
| end CA11020_0.CA11020_1; |
| |
| --==================================================================-- |
| |
| with CA11020_0.CA11020_1; -- Public generic child package. |
| |
| package body CA11020_0 is |
| |
| ---------------------------------------------------- |
| -- Parent's body depends on public generic child. -- |
| ---------------------------------------------------- |
| |
| -- Instantiate the public child. |
| |
| package MS is new CA11020_1; |
| |
| function Bag_Image (B : Bag) return string is |
| |
| Buffer : String (1 .. 10_000); |
| Last : Integer := 0; |
| |
| ----------------------------------------------------- |
| |
| -- Will be called by the iterator. |
| |
| procedure Append_Image (E : in Element) is |
| Im : constant String := Image (E); |
| |
| begin -- Append_Image |
| if Last /= 0 then -- Insert a comma. |
| Last := Last + 1; |
| Buffer (Last) := ','; |
| end if; |
| |
| Buffer (Last + 1 .. Last + Im'Length) := Im; |
| Last := Last + Im'Length; |
| |
| end Append_Image; |
| |
| ----------------------------------------------------- |
| |
| -- Instantiate procedure Iterate as a child of instance MS. |
| |
| procedure Append_All is new MS.Iterate (Use_Element => Append_Image); |
| |
| begin -- Bag_Image |
| |
| Append_All (B); |
| |
| return Buffer (1 .. Last); |
| |
| end Bag_Image; |
| |
| ----------------------------------------------------- |
| |
| procedure Add (E : in Element; To_The_Bag : in out Bag) is |
| |
| -- Not a real bag addition. |
| |
| Index : Bag := To_The_Bag; |
| |
| begin |
| -- ... Error-checking code omitted for brevity. |
| |
| if Index = null then |
| To_The_Bag := new Node_Type' (The_Element => E, |
| Next => null); |
| else |
| -- Goto the end of the list. |
| |
| while Index.Next /= null loop |
| Index := Index.Next; |
| end loop; |
| |
| -- Add element to the end of the list. |
| |
| Index.Next := new Node_Type' (The_Element => E, |
| Next => null); |
| end if; |
| |
| end Add; |
| |
| end CA11020_0; |
| |
| --==================================================================-- |
| |
| with CA11020_0; -- Bag application. |
| |
| with Report; |
| |
| procedure CA11020 is |
| |
| -- Instantiate the bag application for integer type and attribute |
| -- Image. |
| |
| package Bag_Of_Integers is new CA11020_0 (Integer, Integer'Image); |
| |
| My_Bag : Bag_Of_Integers.Bag; |
| |
| begin |
| |
| Report.Test ("CA11020", "Check that body of the generic parent package " & |
| "can depend on one of its own public generic children"); |
| |
| -- Add 10 consecutive integers to the bag. |
| |
| for I in 1 .. 10 loop |
| Bag_Of_Integers.Add (I, My_Bag); |
| end loop; |
| |
| if Bag_Of_Integers.Bag_Image (My_Bag) |
| /= " 1, 2, 3, 4, 5, 6, 7, 8, 9, 10" then |
| Report.Failed ("Incorrect results"); |
| end if; |
| |
| Report.Result; |
| |
| end CA11020; |