1-- CA11003.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 a public grandchild can utilize its ancestor unit's visible 28-- definitions. 29-- 30-- TEST DESCRIPTION: 31-- Declare a public package, public child package, and public 32-- grandchild package and library unit function. Within the 33-- grandchild package and function, make use of components that are 34-- declared in the ancestor packages, both parent and grandparent. 35-- 36-- Use the following ancestral components in the grandchildren library 37-- units: 38-- Grandparent Parent 39-- Type X X 40-- Constant X X 41-- Object X X 42-- Subprogram X X 43-- Exception X X 44-- 45-- 46-- CHANGE HISTORY: 47-- 06 Dec 94 SAIC ACVC 2.0 48-- 21 Dec 94 SAIC Modified procedure Create_File 49-- 15 Nov 95 SAIC Update and repair for ACVC 2.0.1 50-- 51--! 52 53package CA11003_0 is -- Package OS 54 55 type File_Descriptor is new Integer; 56 type File_Mode is (Read_Only, Write_Only, Read_Write); 57 58 Null_File : constant File_Descriptor := 0; 59 Default_Mode : constant File_Mode := Read_Only; 60 File_Data_Error : exception; 61 62 type File_Type is tagged 63 record 64 Descriptor : File_Descriptor := Null_File; 65 Mode : File_Mode := Read_Write; 66 end record; 67 68 System_File : File_Type; 69 70 function Next_Available_File return File_Descriptor; 71 72 procedure Reclaim_File_Descriptor; 73 74end CA11003_0; -- Package OS 75 76 --=================================================================-- 77 78package body CA11003_0 is -- Package body OS 79 80 File_Count : Integer := 0; 81 82 function Next_Available_File return File_Descriptor is 83 begin 84 File_Count := File_Count + 1; 85 return (File_Descriptor(File_Count)); 86 end Next_Available_File; 87 -------------------------------------------------- 88 procedure Reclaim_File_Descriptor is 89 begin 90 null; -- Dummy processing unit. 91 end Reclaim_File_Descriptor; 92 93end CA11003_0; -- Package body OS 94 95 --=================================================================-- 96 97package CA11003_0.CA11003_1 is -- Child package OS.Operations 98 99 subtype File_Length_Type is Integer range 0 .. 1000; 100 Min_File_Size : File_Length_Type := File_Length_Type'First; 101 Max_File_Size : File_Length_Type := File_Length_Type'Last; 102 103 File_Duplication_Error : exception; 104 105 type Extended_File_Type is new File_Type with private; 106 107 procedure Create_File (Mode : in File_Mode; 108 File : out Extended_File_Type); 109 110 procedure Duplicate_File (Original : in Extended_File_Type; 111 Duplicate : out Extended_File_Type); 112 113private 114 type Extended_File_Type is new File_Type with 115 record 116 Blocks : File_Length_Type := Min_File_Size; 117 end record; 118 119 System_Extended_File : Extended_File_Type; 120 121end CA11003_0.CA11003_1; -- Child Package OS.Operations 122 123 --=================================================================-- 124 125package body CA11003_0.CA11003_1 is -- Child package body OS.Operations 126 127 procedure Create_File 128 (Mode : in File_Mode; 129 File : out Extended_File_Type) is 130 begin 131 File.Descriptor := Next_Available_File; -- Parent subprogram. 132 File.Mode := Default_Mode; -- Parent constant. 133 File.Blocks := Min_File_Size; 134 end Create_File; 135 -------------------------------------------------- 136 procedure Duplicate_File (Original : in Extended_File_Type; 137 Duplicate : out Extended_File_Type) is 138 begin 139 Duplicate.Descriptor := Next_Available_File; -- Parent subprogram. 140 Duplicate.Mode := Original.Mode; 141 Duplicate.Blocks := Original.Blocks; 142 end Duplicate_File; 143 144end CA11003_0.CA11003_1; -- Child package body OS.Operations 145 146 --=================================================================-- 147 148-- This package contains menu selectable operations for manipulating files. 149-- This abstraction builds on the capabilities available from ancestor 150-- packages. 151 152package CA11003_0.CA11003_1.CA11003_2 is 153 154 procedure News (Mode : in File_Mode; 155 File : out Extended_File_Type); 156 157 procedure Copy (Original : in Extended_File_Type; 158 Duplicate : out Extended_File_Type); 159 160 procedure Delete (File : in Extended_File_Type); 161 162end CA11003_0.CA11003_1.CA11003_2; -- Grandchild package OS.Operations.Menu 163 164 --=================================================================-- 165 166-- Grandchild subprogram Validate 167function CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type) 168 return Boolean; 169 170 --=================================================================-- 171 172-- Grandchild subprogram Validate 173function CA11003_0.CA11003_1.CA11003_3 174 (File : in Extended_File_Type) -- Parent type. 175 return Boolean is 176 177 function New_File_Validated (File : Extended_File_Type) 178 return Boolean is 179 begin 180 if (File.Descriptor > System_File.Descriptor) and -- Grandparent 181 (File.Mode in File_Mode ) and -- object and type 182 not ((File.Blocks < System_Extended_File.Blocks) or 183 (File.Blocks > Max_File_Size)) -- Parent object 184 then -- and constant. 185 return True; 186 else 187 return False; 188 end if; 189 end New_File_Validated; 190 191begin 192 return (New_File_Validated (File)) and 193 (File.Descriptor /= Null_File); -- Grandparent constant. 194 195end CA11003_0.CA11003_1.CA11003_3; -- Grandchild subprogram Validate 196 197 --=================================================================-- 198 199with CA11003_0.CA11003_1.CA11003_3; 200 -- Grandchild package body OS.Operations.Menu 201package body CA11003_0.CA11003_1.CA11003_2 is 202 203 procedure News (Mode : in File_Mode; 204 File : out Extended_File_Type) is -- Parent type. 205 begin 206 Create_File (Mode, File); -- Parent subprogram. 207 if not CA11003_0.CA11003_1.CA11003_3 (File) then 208 raise File_Data_Error; -- Grandparent exception. 209 end if; 210 end News; 211 -------------------------------------------------- 212 procedure Copy (Original : in Extended_File_Type; 213 Duplicate : out Extended_File_Type) is 214 begin 215 Duplicate_File (Original, Duplicate); -- Parent subprogram. 216 217 if Original.Descriptor = Duplicate.Descriptor then 218 raise File_Duplication_Error; -- Parent exception. 219 end if; 220 221 end Copy; 222 -------------------------------------------------- 223 procedure Delete (File : in Extended_File_Type) is 224 begin 225 Reclaim_File_Descriptor; -- Grandparent 226 end Delete; -- subprogram. 227 228end CA11003_0.CA11003_1.CA11003_2; 229 230 --=================================================================-- 231 232with CA11003_0.CA11003_1.CA11003_2; -- Grandchild Pkg OS.Operations.Menu 233with CA11003_0.CA11003_1.CA11003_3; -- Grandchild Ftn OS.Operations.Validate 234with Report; 235 236procedure CA11003 is 237 238 package Menu renames CA11003_0.CA11003_1.CA11003_2; 239 240begin 241 242 Report.Test ("CA11003", "Check that a public grandchild can utilize " & 243 "its ancestor unit's visible definitions"); 244 245 File_Processing: -- Validate all of the capabilities contained in 246 -- the Menu package by exercising them on specific 247 -- files. This will demonstrate the use of child 248 -- and grandchild functionality based on components 249 -- that have been declared in the 250 -- parent/grandparent package. 251 declare 252 253 function Validate (File : CA11003_0.CA11003_1.Extended_File_Type) 254 return Boolean renames CA11003_0.CA11003_1.CA11003_3; 255 256 MacWrite_File, 257 Backup_Copy : CA11003_0.CA11003_1.Extended_File_Type; 258 MacWrite_File_Mode : CA11003_0.File_Mode := CA11003_0.Read_Write; 259 260 begin 261 262 Menu.News (MacWrite_File_Mode, MacWrite_File); 263 264 if not Validate (MacWrite_File) then 265 Report.Failed ("Incorrect initialization of files"); 266 end if; 267 268 Menu.Copy (MacWrite_File, Backup_Copy); 269 270 if not (Validate (MacWrite_File) and 271 Validate (Backup_Copy)) 272 then 273 Report.Failed ("Incorrect duplication of files"); 274 end if; 275 276 Menu.Delete (Backup_Copy); 277 278 exception 279 when CA11003_0.File_Data_Error => 280 Report.Failed ("Exception raised during file validation"); 281 when CA11003_0.CA11003_1.File_Duplication_Error => 282 Report.Failed ("Exception raised during file duplication"); 283 when others => 284 Report.Failed ("Unexpected exception in test procedure"); 285 286 end File_Processing; 287 288 Report.Result; 289 290end CA11003; 291