1-- CDE0001.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 the following names can be used in the declaration of a 28-- generic formal parameter (object, array type, or access type) without 29-- causing freezing of the named type: 30-- (1) The name of a private type, 31-- (2) A name that denotes a subtype of a private type, and 32-- (3) A name that denotes a composite type with a subcomponent of a 33-- private type (or subtype). 34-- Check for untagged and tagged types. 35-- 36-- TEST DESCRIPTION: 37-- This transition test defines private and limited private types, 38-- subtypes of these private types, records and arrays of both types and 39-- subtypes, a tagged type and a private extension. 40-- This test creates examples where the above types are used in the 41-- definition of several generic formal type parameters (object, array 42-- type, or access type) in both visible and private parts. These 43-- visible and private generic packages are instantiated in the body of 44-- the public child and the private child, respectively. 45-- The main program utilizes the functions declared in the public child 46-- to verify results of the instantiations. 47-- 48-- Inspired by B74103F.ADA. 49-- 50-- 51-- CHANGE HISTORY: 52-- 12 Mar 96 SAIC Initial version for ACVC 2.1. 53-- 05 Oct 96 SAIC ACVC 2.1: Added pragma Elaborate for CDE0001. 54-- 21 Nov 98 RLB Added pragma Elaborate for CDE0001 to CDE0001_3. 55--! 56 57package CDE0001_0 is 58 59 subtype Small_Int is Integer range 1 .. 2; 60 61 type Private_Type is private; 62 type Limited_Private is limited private; 63 64 subtype Private_Subtype is Private_Type; 65 subtype Limited_Private_Subtype is Limited_Private; 66 67 type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype; 68 69 type Rec_Of_Limited_Private is 70 record 71 C1 : Limited_Private; 72 end record; 73 74 type Rec_Of_Private_SubType is 75 record 76 C1 : Private_SubType; 77 end record; 78 79 type Tag_Type is tagged 80 record 81 C1 : Small_Int; 82 end record; 83 84 type New_TagType is new Tag_Type with private; 85 86 generic 87 88 Formal_Obj01 : in out Private_Type; -- Formal objects defined 89 Formal_Obj02 : in out Limited_Private; -- by names of private 90 Formal_Obj03 : in out Private_Subtype; -- types, names that 91 Formal_Obj04 : in out Limited_Private_Subtype; -- denotes subtypes of 92 Formal_Obj05 : in out New_TagType; -- the private types. 93 94 package CDE0001_1 is 95 procedure Assign_Objects; 96 97 end CDE0001_1; 98 99private 100 101 generic 102 -- Formal array types of a private type, a composite type with a 103 -- subcomponent of a private type. 104 105 type Formal_Arr01 is array (Small_Int) of Private_Type; 106 type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private; 107 108 -- Formal access types of composite types with a subcomponent of 109 -- a private subtype. 110 111 type Formal_Acc01 is access Rec_Of_Private_Subtype; 112 type Formal_Acc02 is access Array_Of_LP_Subtype; 113 114 package CDE0001_2 is 115 116 procedure Assign_Arrays (P1 : out Formal_Arr01; 117 P2 : out Formal_Arr02); 118 119 procedure Assign_Access (P1 : out Formal_Acc01; 120 P2 : out Formal_Acc02); 121 122 end CDE0001_2; 123 124 ---------------------------------------------------------- 125 type Private_Type is range 1 .. 10; 126 type Limited_Private is (Eh, Bee, Sea, Dee); 127 type New_TagType is new Tag_Type with 128 record 129 C2 : Private_Type; 130 end record; 131 132end CDE0001_0; 133 134 --==================================================================-- 135 136package body CDE0001_0 is 137 138 package body CDE0001_1 is 139 140 procedure Assign_Objects is 141 begin 142 Formal_Obj01 := Private_Type'First; 143 Formal_Obj02 := Limited_Private'Last; 144 Formal_Obj03 := Private_Subtype'Last; 145 Formal_Obj04 := Limited_Private_Subtype'First; 146 Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last); 147 148 end Assign_Objects; 149 150 end CDE0001_1; 151 152 --===========================================================-- 153 154 package body CDE0001_2 is 155 156 procedure Assign_Arrays (P1 : out Formal_Arr01; 157 P2 : out Formal_Arr02) is 158 begin 159 P1(1) := Private_Type'Pred(Private_Type'Last); 160 P1(2) := Private_Type'Succ(Private_Type'First); 161 P2(1).C1 := Limited_Private'Succ(Limited_Private'First); 162 P2(2).C1 := Limited_Private'Pred(Limited_Private'Last); 163 164 end Assign_Arrays; 165 166 ----------------------------------------------------------------- 167 procedure Assign_Access (P1 : out Formal_Acc01; 168 P2 : out Formal_Acc02) is 169 begin 170 P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last); 171 P2 := new Array_Of_LP_Subtype'(Eh, Dee); 172 173 end Assign_Access; 174 175 end CDE0001_2; 176 177end CDE0001_0; 178 179 --==================================================================-- 180 181-- The following private child package instantiates its parent private generic 182-- package. 183 184with CDE0001_0; 185pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated. 186private 187package CDE0001_0.CDE0001_3 is 188 189 type Arr01 is array (Small_Int) of Private_Type; 190 type Arr02 is array (Small_Int) of Rec_Of_Limited_Private; 191 type Acc01 is access Rec_Of_Private_Subtype; 192 type Acc02 is access Array_Of_LP_Subtype; 193 194 package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02); 195 196 Arr01_Obj : Arr01; 197 Arr02_Obj : Arr02; 198 Acc01_Obj : Acc01; 199 Acc02_Obj : Acc02; 200 201end CDE0001_0.CDE0001_3; 202 203 --==================================================================-- 204 205package CDE0001_0.CDE0001_4 is 206 207 -- The following functions check the private types defined in the parent 208 -- and the private child package from within the client program. 209 210 function Verify_Objects return Boolean; 211 212 function Verify_Arrays return Boolean; 213 214 function Verify_Access return Boolean; 215 216end CDE0001_0.CDE0001_4; 217 218 --==================================================================-- 219 220with CDE0001_0.CDE0001_3; -- private sibling. 221 222pragma Elaborate (CDE0001_0.CDE0001_3); 223 224package body CDE0001_0.CDE0001_4 is 225 226 Obj1 : Private_Type := 2; 227 Obj2 : Limited_Private := Bee; 228 Obj3 : Private_Subtype := 3; 229 Obj4 : Limited_Private_Subtype := Sea; 230 Obj5 : New_TagType := (1, 5); 231 232 -- Instantiate the generic package declared in the visible part of 233 -- the parent. 234 235 package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5); 236 237 --------------------------------------------------- 238 function Verify_Objects return Boolean is 239 Result : Boolean := False; 240 begin 241 if Obj1 = 1 and 242 Obj2 = Dee and 243 Obj3 = 10 and 244 Obj4 = Eh and 245 Obj5.C1 = 2 and 246 Obj5.C2 = 10 then 247 Result := True; 248 end if; 249 250 return Result; 251 252 end Verify_Objects; 253 254 --------------------------------------------------- 255 function Verify_Arrays return Boolean is 256 Result : Boolean := False; 257 begin 258 if CDE0001_0.CDE0001_3.Arr01_Obj(1) = 9 and 259 CDE0001_0.CDE0001_3.Arr01_Obj(2) = 2 and 260 CDE0001_0.CDE0001_3.Arr02_Obj(1).C1 = Bee and 261 CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea then 262 Result := True; 263 end if; 264 265 return Result; 266 267 end Verify_Arrays; 268 269 --------------------------------------------------- 270 function Verify_Access return Boolean is 271 Result : Boolean := False; 272 begin 273 if CDE0001_0.CDE0001_3.Acc01_Obj.C1 = 10 and 274 CDE0001_0.CDE0001_3.Acc02_Obj(1) = Eh and 275 CDE0001_0.CDE0001_3.Acc02_Obj(2) = Dee then 276 Result := True; 277 end if; 278 279 return Result; 280 281 end Verify_Access; 282 283begin 284 285 Formal_Obj_Pck.Assign_Objects; 286 287 CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Arrays 288 (CDE0001_0.CDE0001_3.Arr01_Obj, CDE0001_0.CDE0001_3.Arr02_Obj); 289 CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access 290 (CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj); 291 292end CDE0001_0.CDE0001_4; 293 294 --==================================================================-- 295 296with Report; 297with CDE0001_0.CDE0001_4; 298 299procedure CDE0001 is 300 301begin 302 303 Report.Test ("CDE0001", "Check that the name of the private type, a " & 304 "name that denotes a subtype of the private type, or a " & 305 "name that denotes a composite type with a subcomponent " & 306 "of a private type can be used in the declaration of a " & 307 "generic formal type parameter without causing freezing " & 308 "of the named type"); 309 310 if not CDE0001_0.CDE0001_4.Verify_Objects then 311 Report.Failed ("Wrong values for formal objects"); 312 end if; 313 314 if not CDE0001_0.CDE0001_4.Verify_Arrays then 315 Report.Failed ("Wrong values for formal array types"); 316 end if; 317 318 if not CDE0001_0.CDE0001_4.Verify_Access then 319 Report.Failed ("Wrong values for formal access types"); 320 end if; 321 322 Report.Result; 323 324end CDE0001; 325