1-- CA11020.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 generic parent package can depend on one of 28-- its own public generic children. 29-- 30-- TEST DESCRIPTION: 31-- A scenario is created that demonstrates the potential of adding a 32-- public generic 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 bag abstraction in a generic package. Declare a public 38-- generic child of this package which adds a generic procedure to the 39-- original subsystem. In the parent body, instantiate the public 40-- child. Then instantiate the procedure as a child instance of the 41-- public child instance. 42-- 43-- In the main program, declare an instance of parent. Check that the 44-- operations in both parent and child packages perform as expected. 45-- 46-- 47-- CHANGE HISTORY: 48-- 06 Dec 94 SAIC ACVC 2.0 49-- 50--! 51 52-- Simulates bag application. 53 54generic 55 type Element is private; 56 with function Image (E : Element) return String; 57 58package CA11020_0 is 59 60 type Bag is limited private; 61 62 procedure Add (E : in Element; To_The_Bag : in out Bag); 63 64 function Bag_Image (B : Bag) return string; 65 66private 67 type Node_Type; 68 type Bag is access Node_Type; 69 70 type Node_Type is 71 record 72 The_Element : Element; 73 74 -- Other components in real application, i.e., 75 -- The_Count : positive; 76 77 Next : Bag; 78 end record; 79 80end CA11020_0; 81 82 --==================================================================-- 83 84-- More operations on Bag. 85 86generic 87 88-- Parameters go here. 89 90package CA11020_0.CA11020_1 is 91 92 -- ... Other declarations. 93 94 generic -- Generic iterator procedure. 95 with procedure Use_Element (E : in Element); 96 97 procedure Iterate (B : in Bag); -- Called once per element in the bag. 98 99 -- ... Various other operations. 100 101end CA11020_0.CA11020_1; 102 103 --==================================================================-- 104 105package body CA11020_0.CA11020_1 is 106 107 procedure Iterate (B : in Bag) is 108 109 -- Traverse each element in the bag. 110 111 Elem : Bag := B; 112 113 begin 114 while Elem /= null loop 115 Use_Element (Elem.The_Element); 116 Elem := Elem.Next; 117 end loop; 118 119 end Iterate; 120 121end CA11020_0.CA11020_1; 122 123 --==================================================================-- 124 125with CA11020_0.CA11020_1; -- Public generic child package. 126 127package body CA11020_0 is 128 129 ---------------------------------------------------- 130 -- Parent's body depends on public generic child. -- 131 ---------------------------------------------------- 132 133 -- Instantiate the public child. 134 135 package MS is new CA11020_1; 136 137 function Bag_Image (B : Bag) return string is 138 139 Buffer : String (1 .. 10_000); 140 Last : Integer := 0; 141 142 ----------------------------------------------------- 143 144 -- Will be called by the iterator. 145 146 procedure Append_Image (E : in Element) is 147 Im : constant String := Image (E); 148 149 begin -- Append_Image 150 if Last /= 0 then -- Insert a comma. 151 Last := Last + 1; 152 Buffer (Last) := ','; 153 end if; 154 155 Buffer (Last + 1 .. Last + Im'Length) := Im; 156 Last := Last + Im'Length; 157 158 end Append_Image; 159 160 ----------------------------------------------------- 161 162 -- Instantiate procedure Iterate as a child of instance MS. 163 164 procedure Append_All is new MS.Iterate (Use_Element => Append_Image); 165 166 begin -- Bag_Image 167 168 Append_All (B); 169 170 return Buffer (1 .. Last); 171 172 end Bag_Image; 173 174 ----------------------------------------------------- 175 176 procedure Add (E : in Element; To_The_Bag : in out Bag) is 177 178 -- Not a real bag addition. 179 180 Index : Bag := To_The_Bag; 181 182 begin 183 -- ... Error-checking code omitted for brevity. 184 185 if Index = null then 186 To_The_Bag := new Node_Type' (The_Element => E, 187 Next => null); 188 else 189 -- Goto the end of the list. 190 191 while Index.Next /= null loop 192 Index := Index.Next; 193 end loop; 194 195 -- Add element to the end of the list. 196 197 Index.Next := new Node_Type' (The_Element => E, 198 Next => null); 199 end if; 200 201 end Add; 202 203end CA11020_0; 204 205 --==================================================================-- 206 207with CA11020_0; -- Bag application. 208 209with Report; 210 211procedure CA11020 is 212 213 -- Instantiate the bag application for integer type and attribute 214 -- Image. 215 216 package Bag_Of_Integers is new CA11020_0 (Integer, Integer'Image); 217 218 My_Bag : Bag_Of_Integers.Bag; 219 220begin 221 222 Report.Test ("CA11020", "Check that body of the generic parent package " & 223 "can depend on one of its own public generic children"); 224 225 -- Add 10 consecutive integers to the bag. 226 227 for I in 1 .. 10 loop 228 Bag_Of_Integers.Add (I, My_Bag); 229 end loop; 230 231 if Bag_Of_Integers.Bag_Image (My_Bag) 232 /= " 1, 2, 3, 4, 5, 6, 7, 8, 9, 10" then 233 Report.Failed ("Incorrect results"); 234 end if; 235 236 Report.Result; 237 238end CA11020; 239