1-- CA11006.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 private part of a child library unit can utilize 28-- its parent unit's private definition. 29-- 30-- TEST DESCRIPTION: 31-- Declare a package and public child package, both with private 32-- parts. The child package will have a private extension of a type 33-- declared in the parent's private part. In addition, the private 34-- part of the child package specification will make use of some of 35-- the components declared in the private part of the parent. 36-- 37-- 38-- CHANGE HISTORY: 39-- 06 Dec 94 SAIC ACVC 2.0 40-- 15 Nov 95 SAIC Update and repair for ACVC 2.0.1 41-- 42--! 43 44package CA11006_0 is -- Package File_Package 45 46 type File_Descriptor is private; 47 type File_Mode is (Read_Only, Write_Only, Read_Write); 48 type File_Type is tagged private; 49 50 function Next_Available_File return File_Descriptor; 51 52private 53 54 type File_Measure is range 0 .. 1000; 55 type File_Descriptor is new Integer; 56 57 Null_File : constant File_Descriptor := 0; 58 Default_Mode : constant File_Mode := Read_Write; 59 60 type File_Type is tagged 61 record 62 Descriptor : File_Descriptor := Null_File; 63 Mode : File_Mode := Default_Mode; 64 end record; 65 66 System_File : File_Type; 67 68end CA11006_0; -- Package File_Package 69 70 --=================================================================-- 71 72package body CA11006_0 is -- Package File_Package 73 74 File_Count : Integer := 0; 75 76 function Next_Available_File return File_Descriptor is 77 begin 78 File_Count := File_Count + 1; 79 return File_Descriptor (File_Count); 80 end Next_Available_File; 81 82end CA11006_0; -- Package File_Package 83 84 --=================================================================-- 85 86package CA11006_0.CA11006_1 is -- Child package File_Package.Operations 87 88 type File_Length_Type is private; 89 type Extended_File_Type is new File_Type with private; 90 91 System_Extended_File : constant Extended_File_Type; 92 93 procedure Create_File (Mode : in File_Mode; 94 File : out Extended_File_Type); 95 96 procedure Compress_File (Original : in Extended_File_Type; 97 Compressed_File : out Extended_File_Type); 98 99 function Validate (File : in Extended_File_Type) return Boolean; 100 101 function Validate_Compression (File : in Extended_File_Type) 102 return Boolean; 103 -- These two validation functions provide 104 -- the capability to check the private 105 -- components defined in the parent and 106 -- child packages from within the client 107 -- program. 108private 109 110 type File_Length_Type is new File_Measure; -- Parent private type. 111 112 Min_File_Size : File_Length_Type := File_Length_Type'First; 113 Max_File_Size : File_Length_Type := File_Length_Type'Last; 114 115 type Extended_File_Type is new File_Type with -- Parent type. 116 record 117 Blocks : File_Length_Type := Min_File_Size; 118 end record; 119 120 System_Extended_File : constant Extended_File_Type := 121 (Descriptor => System_File.Descriptor, -- Parent private object. 122 Mode => Read_Only, -- Parent enumeration literal. 123 Blocks => Min_File_Size); 124 125 126end CA11006_0.CA11006_1; -- Child Package File_Package.Operations 127 128 --=================================================================-- 129 130 -- Child package body File_Package.Operations 131package body CA11006_0.CA11006_1 is 132 133 procedure Create_File 134 (Mode : in File_Mode; 135 File : out Extended_File_Type) is 136 begin 137 File.Descriptor := Next_Available_File; -- Parent subprogram. 138 File.Mode := Default_Mode; -- Parent private constant. 139 File.Blocks := Max_File_Size; 140 end Create_File; 141 ------------------------------------------------------------------------ 142 procedure Compress_File (Original : in Extended_File_Type; 143 Compressed_File : out Extended_File_Type) is 144 begin 145 Compressed_File.Descriptor := Next_Available_File; 146 Compressed_File.Mode := Read_Only; 147 Compressed_File.Blocks := Original.Blocks / 2; -- Simulated file 148 end Compress_File; -- compression. 149 ------------------------------------------------------------------------ 150 function Validate (File : in Extended_File_Type) return Boolean is 151 begin 152 if ((File.Descriptor /= System_Extended_File.Descriptor) and 153 (File.Mode = Read_Write) and 154 (File.Blocks = Max_File_Size)) then 155 return True; 156 else 157 return False; 158 end if; 159 end Validate; 160 ------------------------------------------------------------------------ 161 function Validate_Compression (File : in Extended_File_Type) 162 return Boolean is 163 begin 164 if ((File.Descriptor /= System_File.Descriptor) and 165 (File.Mode = Read_Only) and 166 (File.Blocks = Max_File_Size/2)) then 167 return True; 168 else 169 return False; 170 end if; 171 end Validate_Compression; 172 173end CA11006_0.CA11006_1; -- Child package body File_Package.Operations 174 175 --=================================================================-- 176 177with CA11006_0.CA11006_1; -- with Child package File_Package.Operations 178with Report; 179 180procedure CA11006 is 181 182 package File renames CA11006_0; 183 package File_Ops renames CA11006_0.CA11006_1; 184 185 Validation_File_Mode : File.File_Mode := File.Read_Only; 186 Validation_File, 187 Storage_Copy : File_Ops.Extended_File_Type; 188 189begin 190 191 Report.Test ("CA11006", "Check that the private part of a child " & 192 "library unit can utilize its parent " & 193 "unit's private definition"); 194 195 File_Ops.Create_File (Validation_File_Mode, Validation_File); 196 197 if not File_Ops.Validate (Validation_File) then 198 Report.Failed ("Incorrect initialization of file"); 199 end if; 200 201 File_Ops.Compress_File (Validation_File, Storage_Copy); 202 203 if not (File_Ops.Validate (Validation_File) and 204 File_Ops.Validate_Compression (Storage_Copy)) 205 then 206 Report.Failed ("Incorrect compression of file"); 207 end if; 208 209 Report.Result; 210 211end CA11006; 212