1-- CA11014.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 an instantiation of a child package of a generic package 28-- can use its parent's declarations and operations, including a formal 29-- package of the parent. 30-- 31-- TEST DESCRIPTION: 32-- Declare a list abstraction in a generic package which manages lists of 33-- elements of any discrete type. Declare a generic package which 34-- operates on lists of elements of integer types. Declare a generic 35-- child of this package which defines additional list operations. 36-- Use the formal discrete type as the generic formal actual part for the 37-- parent formal package. 38-- 39-- Declare an instance of parent, then declare an instance of the child 40-- which is itself a child the parent's instance. In the main program, 41-- check that the operations in both instances perform as expected. 42-- 43-- 44-- CHANGE HISTORY: 45-- 06 Dec 94 SAIC ACVC 2.0 46-- 15 Nov 95 SAIC Update and repair for ACVC 2.0.1 47-- 07 Sep 96 SAIC Change formal param E to be out only. 48-- 19 Oct 96 SAIC ACVC 2.1: Added pragma Elaborate to context 49-- clauses of CA11014_0, CA11014_1, and CA11014_5. 50-- 27 Feb 97 PWB.CTA Added elaboration pragma at package CA11014_4 51--! 52 53-- Actual package for the parent's formal. 54generic 55 56 type Element_Type is (<>); -- List elems may be of any discrete types. 57 58package CA11014_0 is 59 60 type Node_Type; 61 type Node_Pointer is access Node_Type; 62 63 type Node_Type is record 64 Item : Element_Type; 65 Next : Node_Pointer := null; 66 end record; 67 68 type List_Type is record 69 First : Node_Pointer := null; 70 Current : Node_Pointer := null; 71 Last : Node_Pointer := null; 72 end record; 73 74 -- Return true if current element is last in the list. 75 function End_Of_List (L : List_Type) return boolean; 76 77 -- Set "current" pointer to first list element. 78 procedure Reset (L : in out List_Type); 79 80end CA11014_0; 81 82 --==================================================================-- 83 84package body CA11014_0 is 85 86 function End_Of_List (L : List_Type) return boolean is 87 begin 88 return (L.Current = null); 89 end End_Of_List; 90 ------------------------------------------------------- 91 procedure Reset (L : in out List_Type) is 92 begin 93 L.Current := L.First; -- Set "current" pointer to first 94 end Reset; -- list element. 95 96end CA11014_0; 97 98 --==================================================================-- 99 100with CA11014_0; -- Generic list abstraction. 101pragma Elaborate (CA11014_0); 102generic 103 104 -- Import the list abstraction defined in CA11014_0. 105 with package List_Mgr is new CA11014_0 (<>); 106 107package CA11014_1 is 108 109 -- Write to current element and advance "current" pointer. 110 procedure Write_Element (L : in out List_Mgr.List_Type; 111 E : in List_Mgr.Element_Type); 112 113 -- Read from current element and advance "current" pointer. 114 procedure Read_Element (L : in out List_Mgr.List_Type; 115 E : out List_Mgr.Element_Type); 116 117 -- Add element to end of list. 118 procedure Add_Element (L : in out List_Mgr.List_Type; 119 E : in List_Mgr.Element_Type); 120 121end CA11014_1; 122 123 --==================================================================-- 124 125package body CA11014_1 is 126 127 procedure Write_Element (L : in out List_Mgr.List_Type; 128 E : in List_Mgr.Element_Type) is 129 begin 130 L.Current.Item := E; -- Write to current element. 131 L.Current := L.Current.Next; -- Advance "current" pointer. 132 end Write_Element; 133 ------------------------------------------------------- 134 procedure Read_Element (L : in out List_Mgr.List_Type; 135 E : out List_Mgr.Element_Type) is 136 begin 137 E := L.Current.Item; -- Retrieve current element. 138 L.Current := L.Current.Next; -- Advance "current" pointer. 139 end Read_Element; 140 ------------------------------------------------------- 141 procedure Add_Element (L : in out List_Mgr.List_Type; 142 E : in List_Mgr.Element_Type) is 143 New_Node : List_Mgr.Node_Pointer := new List_Mgr.Node_Type'(E, null); 144 use type List_Mgr.Node_Pointer; 145 begin 146 if L.First = null then -- No elements in list, so add new 147 L.First := New_Node; -- element at beginning of list. 148 else 149 L.Last.Next := New_Node; -- Add new element at end of list. 150 end if; 151 L.Last := New_Node; -- Set last-in-list pointer. 152 end Add_Element; 153 154end CA11014_1; 155 156 --==================================================================-- 157 158-- Generic child of list operation. This child adds a layer of 159-- functionality to the parent generic. 160 161generic 162 163package CA11014_1.CA11014_2 is 164 165 procedure Write_First_To_List (L : in out List_Mgr.List_Type); 166 167 -- ... Various other operations used by the application. 168 169end CA11014_1.CA11014_2; 170 171 --==================================================================-- 172 173package body CA11014_1.CA11014_2 is 174 175 procedure Write_First_To_List (L : in out List_Mgr.List_Type) is 176 begin 177 List_Mgr.Reset (L); -- Parent's formal package. 178 179 while not List_Mgr.End_Of_List (L) loop -- Parent's formal package. 180 Write_Element (L, List_Mgr.Element_Type'First); 181 -- Parent's operation, 182 end loop; -- parent's formal. 183 184 end Write_First_To_List; 185 186end CA11014_1.CA11014_2; 187 188 --==================================================================-- 189 190package CA11014_3 is 191 192 type Points is range 0 .. 100; 193 194 -- ... Various other types used by the application. 195 196end CA11014_3; 197 198 199-- No body for CA11014_3; 200 201 --==================================================================-- 202 203-- Declare instances of the generic list packages for the discrete type. 204-- The instance of the child must itself be declared as a child of the 205-- instance of the parent. 206 207with CA11014_0; -- Generic list abstraction. 208with CA11014_3; -- Package containing discrete type declaration. 209pragma Elaborate (CA11014_0); 210package CA11014_4 is new CA11014_0 (CA11014_3.Points); -- Points list. 211 212with CA11014_4; -- Points list. 213with CA11014_1; -- Generic list operation. 214pragma Elaborate (CA11014_1); 215package CA11014_5 is new CA11014_1 (CA11014_4); -- Scores list. 216 217with CA11014_1.CA11014_2; -- Additional generic list operation, 218with CA11014_5; 219pragma Elaborate (CA11014_5); 220package CA11014_5.CA11014_6 is new CA11014_5.CA11014_2; 221 -- Points list operation. 222 223 --==================================================================-- 224 225with CA11014_1.CA11014_2; -- Additional generic list operation, 226 -- implicitly with list operation. 227with CA11014_3; -- Package containing discrete type declaration. 228with CA11014_4; -- Points list. 229with CA11014_5.CA11014_6; -- Points list operation. 230with Report; 231 232procedure CA11014 is 233 234 package Lists_Of_Scores renames CA11014_4; 235 package Score_Ops renames CA11014_5; 236 package Point_Ops renames CA11014_5.CA11014_6; 237 238 Scores : Lists_Of_Scores.List_Type; -- List of points. 239 240 type TC_Score_Array is array (1 .. 3) of CA11014_3.Points; 241 242 TC_Initial_Values : constant TC_Score_Array := (10, 21, 49); 243 TC_Final_Values : constant TC_Score_Array := (0, 0, 0); 244 245 TC_Initial_Values_Are_Correct : boolean := false; 246 TC_Final_Values_Are_Correct : boolean := false; 247 248 -------------------------------------------------- 249 250 -- Initial list contains 3 scores with the values 10, 21, and 49. 251 procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is 252 begin 253 for I in TC_Score_Array'range loop 254 Score_Ops.Add_Element (L, TC_Initial_Values(I)); 255 -- Operation from generic parent. 256 end loop; 257 end TC_Initialize_List; 258 259 -------------------------------------------------- 260 261 -- Verify that all scores have been set to zero. 262 procedure TC_Verify_List (L : in out Lists_of_Scores.List_Type; 263 Expected : in TC_Score_Array; 264 OK : out boolean) is 265 Actual : TC_Score_Array; 266 begin 267 Lists_of_Scores.Reset (L); -- Operation from parent's formal. 268 for I in TC_Score_Array'range loop 269 Score_Ops.Read_Element (L, Actual(I)); 270 -- Operation from generic parent. 271 end loop; 272 OK := (Actual = Expected); 273 end TC_Verify_List; 274 275 -------------------------------------------------- 276 277begin -- CA11014 278 279 Report.Test ("CA11014", "Check that an instantiation of a child package " & 280 "of a generic package can use its parent's " & 281 "declarations and operations, including a " & 282 "formal package of the parent"); 283 284 TC_Initialize_List (Scores); 285 TC_Verify_List (Scores, TC_Initial_Values, TC_Initial_Values_Are_Correct); 286 287 if not TC_Initial_Values_Are_Correct then 288 Report.Failed ("List contains incorrect initial values"); 289 end if; 290 291 Point_Ops.Write_First_To_List (Scores); 292 -- Operation from generic child package. 293 294 TC_Verify_List (Scores, TC_Final_Values, TC_Final_Values_Are_Correct); 295 296 if not TC_Final_Values_Are_Correct then 297 Report.Failed ("List contains incorrect final values"); 298 end if; 299 300 Report.Result; 301 302end CA11014; 303