1-- CA11019.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-- private generic children. 29-- 30-- TEST DESCRIPTION: 31-- A scenario is created that demonstrates the potential of adding a 32-- generic private child during code maintenance without distubing a 33-- large 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 data collection abstraction in a package. Declare a private 38-- generic child of this package which provides parameterized code that 39-- have been written once and will be used three times to implement the 40-- services of the parent package. In the parent body, instantiate the 41-- private child. 42-- 43-- In the main program, check that the operations in the parent, 44-- and instance of the private child package perform as expected. 45-- 46-- 47-- CHANGE HISTORY: 48-- 06 Dec 94 SAIC ACVC 2.0 49-- 17 Nov 95 SAIC Update and repair for ACVC 2.0.1 50-- 51--! 52 53package CA11019_0 is 54 -- parent 55 56 type Data_Record is tagged private; 57 type Data_Collection is private; 58 --- 59 --- 60 subtype Data_1 is integer range 0 .. 100; 61 procedure Add_1 (Data : Data_1; To : in out Data_Collection); 62 function Statistical_Op_1 (Data : Data_Collection) return Data_1; 63 --- 64 subtype Data_2 is integer range -100 .. 1000; 65 procedure Add_2 (Data : Data_2; To : in out Data_Collection); 66 function Statistical_Op_2 (Data : Data_Collection) return Data_2; 67 --- 68 subtype Data_3 is integer range -10_000 .. 10_000; 69 procedure Add_3 (Data : Data_3; To : in out Data_Collection); 70 function Statistical_Op_3 (Data : Data_Collection) return Data_3; 71 --- 72 73private 74 75 type Data_Ptr is access Data_Record'class; 76 subtype Sequence_Number is positive range 1 .. 512; 77 78 type Data_Record is tagged 79 record 80 Next : Data_Ptr := null; 81 Seq : Sequence_Number; 82 end record; 83 --- 84 type Data_Collection is 85 record 86 First : Data_Ptr := null; 87 Last : Data_Ptr := null; 88 end record; 89 90end CA11019_0; 91 -- parent 92 93 --=================================================================-- 94 95-- This generic package provides parameterized code that has been 96-- written once and will be used three times to implement the services 97-- of the parent package. 98 99private 100generic 101 type Data_Type is range <>; 102 103package CA11019_0.CA11019_1 is 104 -- parent.child 105 106 type Data_Elem is new Data_Record with 107 record 108 Value : Data_Type; 109 end record; 110 111 Next_Avail_Seq_No : Sequence_Number := 1; 112 113 procedure Sequence (Ptr : Data_Ptr); 114 -- the child must be private for this procedure to know details of 115 -- the implementation of data collections 116 117 procedure Add (Datum : Data_Type; To : in out Data_Collection); 118 119 function Op (Data : Data_Collection) return Data_Type; 120 -- op models a complicated operation that whose code can be 121 -- used for various data types 122 123 124end CA11019_0.CA11019_1; 125 -- parent.child 126 127 --=================================================================-- 128 129 130package body CA11019_0.CA11019_1 is 131 -- parent.child 132 133 procedure Sequence (Ptr : Data_Ptr) is 134 begin 135 Ptr.Seq := Next_Avail_Seq_No; 136 Next_Avail_Seq_No := Next_Avail_Seq_No + 1; 137 end Sequence; 138 139 --------------------------------------------------------- 140 141 procedure Add (Datum : Data_Type; To : in out Data_Collection) is 142 Ptr : Data_Ptr; 143 begin 144 if To.First = null then 145 -- assign new record with data value to 146 -- to.next <- null; 147 To.First := new Data_Elem'(Next => null, 148 Value => Datum, 149 Seq => 1); 150 Sequence (To.First); 151 To.Last := To.First; 152 else 153 -- chase to end of list 154 Ptr := To.First; 155 while Ptr.Next /= null loop 156 Ptr := Ptr.Next; 157 end loop; 158 -- and add element there 159 Ptr.Next := new Data_Elem'(Next => null, 160 Value => Datum, 161 Seq => 1); 162 Sequence (Ptr.Next); 163 To.Last := Ptr.Next; 164 end if; 165 166 end Add; 167 168 --------------------------------------------------------- 169 170 function Op (Data : Data_Collection) return Data_Type is 171 -- for simplicity, just return the maximum of the data set 172 Max : Data_Type := Data_Elem( Data.First.all ).Value; 173 -- assuming non-empty collection 174 Ptr : Data_Ptr := Data.First; 175 176 begin 177 -- no error checking 178 while Ptr.Next /= null loop 179 if Data_Elem( Ptr.Next.all ).Value > Max then 180 Max := Data_Elem( Ptr.Next.all ).Value; 181 end if; 182 Ptr := Ptr.Next; 183 end loop; 184 return Max; 185 end Op; 186 187end CA11019_0.CA11019_1; 188 -- parent.child 189 190 --=================================================================-- 191 192-- parent body depends on private generic child 193with CA11019_0.CA11019_1; -- Private generic child. 194 195pragma Elaborate (CA11019_0.CA11019_1); 196package body CA11019_0 is 197 198 -- instantiate the generic child with data types needed by the 199 -- package interface services 200 package Data_1_Ops is new CA11019_1 201 (Data_Type => Data_1); 202 203 package Data_2_Ops is new CA11019_1 204 (Data_Type => Data_2); 205 206 package Data_3_Ops is new CA11019_1 207 (Data_Type => Data_3); 208 209 --------------------------------------------------------- 210 211 procedure Add_1 (Data : Data_1; To : in out Data_Collection) is 212 begin 213 -- maybe do other stuff here 214 Data_1_Ops.Add (Data, To); 215 -- and here 216 end; 217 218 --------------------------------------------------------- 219 220 function Statistical_Op_1 (Data : Data_Collection) return Data_1 is 221 begin 222 -- maybe use generic operation(s) in some complicated ways 223 -- (but simplified out, for the sake of testing) 224 return Data_1_Ops.Op (Data); 225 end; 226 227 --------------------------------------------------------- 228 229 procedure Add_2 (Data : Data_2; To : in out Data_Collection) is 230 begin 231 Data_2_Ops.Add (Data, To); 232 end; 233 234 --------------------------------------------------------- 235 236 function Statistical_Op_2 (Data : Data_Collection) return Data_2 is 237 begin 238 return Data_2_Ops.Op (Data); 239 end; 240 241 --------------------------------------------------------- 242 243 procedure Add_3 (Data : Data_3; To : in out Data_Collection) is 244 begin 245 Data_3_Ops.Add (Data, To); 246 end; 247 248 --------------------------------------------------------- 249 250 function Statistical_Op_3 (Data : Data_Collection) return Data_3 is 251 begin 252 return Data_3_Ops.Op (Data); 253 end; 254 255end CA11019_0; 256 257 258 --=================================================-- 259 260with CA11019_0, 261 -- Main, 262 -- Main.Child is private 263 Report; 264 265procedure CA11019 is 266 267 package Main renames CA11019_0; 268 269 Col_1, 270 Col_2, 271 Col_3 : Main.Data_Collection; 272 273begin 274 275 Report.Test ("CA11019", "Check that body of a (non-generic) package " & 276 "may depend on its private generic child"); 277 278 -- build a data collection 279 280 for I in 1 .. 10 loop 281 Main.Add_1 ( Main.Data_1(I), Col_1); 282 end loop; 283 284 if Main.Statistical_Op_1 (Col_1) /= 10 then 285 Report.Failed ("Wrong data_1 value returned"); 286 end if; 287 288 for I in reverse 10 .. 20 loop 289 Main.Add_2 ( Main.Data_2(I * 10), Col_2); 290 end loop; 291 292 if Main.Statistical_Op_2 (Col_2) /= 200 then 293 Report.Failed ("Wrong data_2 value returned"); 294 end if; 295 296 for I in 0 .. 10 loop 297 Main.Add_3 ( Main.Data_3(I + 5), Col_3); 298 end loop; 299 300 if Main.Statistical_Op_3 (Col_3) /= 15 then 301 Report.Failed ("Wrong data_3 value returned"); 302 end if; 303 304 Report.Result; 305 306end CA11019; 307