-- CA11003.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that a public grandchild can utilize its ancestor unit's visible -- definitions. -- -- TEST DESCRIPTION: -- Declare a public package, public child package, and public -- grandchild package and library unit function. Within the -- grandchild package and function, make use of components that are -- declared in the ancestor packages, both parent and grandparent. -- -- Use the following ancestral components in the grandchildren library -- units: -- Grandparent Parent -- Type X X -- Constant X X -- Object X X -- Subprogram X X -- Exception X X -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 21 Dec 94 SAIC Modified procedure Create_File -- 15 Nov 95 SAIC Update and repair for ACVC 2.0.1 -- --! package CA11003_0 is -- Package OS type File_Descriptor is new Integer; type File_Mode is (Read_Only, Write_Only, Read_Write); Null_File : constant File_Descriptor := 0; Default_Mode : constant File_Mode := Read_Only; File_Data_Error : exception; type File_Type is tagged record Descriptor : File_Descriptor := Null_File; Mode : File_Mode := Read_Write; end record; System_File : File_Type; function Next_Available_File return File_Descriptor; procedure Reclaim_File_Descriptor; end CA11003_0; -- Package OS --=================================================================-- package body CA11003_0 is -- Package body OS File_Count : Integer := 0; function Next_Available_File return File_Descriptor is begin File_Count := File_Count + 1; return (File_Descriptor(File_Count)); end Next_Available_File; -------------------------------------------------- procedure Reclaim_File_Descriptor is begin null; -- Dummy processing unit. end Reclaim_File_Descriptor; end CA11003_0; -- Package body OS --=================================================================-- package CA11003_0.CA11003_1 is -- Child package OS.Operations subtype File_Length_Type is Integer range 0 .. 1000; Min_File_Size : File_Length_Type := File_Length_Type'First; Max_File_Size : File_Length_Type := File_Length_Type'Last; File_Duplication_Error : exception; type Extended_File_Type is new File_Type with private; procedure Create_File (Mode : in File_Mode; File : out Extended_File_Type); procedure Duplicate_File (Original : in Extended_File_Type; Duplicate : out Extended_File_Type); private type Extended_File_Type is new File_Type with record Blocks : File_Length_Type := Min_File_Size; end record; System_Extended_File : Extended_File_Type; end CA11003_0.CA11003_1; -- Child Package OS.Operations --=================================================================-- package body CA11003_0.CA11003_1 is -- Child package body OS.Operations procedure Create_File (Mode : in File_Mode; File : out Extended_File_Type) is begin File.Descriptor := Next_Available_File; -- Parent subprogram. File.Mode := Default_Mode; -- Parent constant. File.Blocks := Min_File_Size; end Create_File; -------------------------------------------------- procedure Duplicate_File (Original : in Extended_File_Type; Duplicate : out Extended_File_Type) is begin Duplicate.Descriptor := Next_Available_File; -- Parent subprogram. Duplicate.Mode := Original.Mode; Duplicate.Blocks := Original.Blocks; end Duplicate_File; end CA11003_0.CA11003_1; -- Child package body OS.Operations --=================================================================-- -- This package contains menu selectable operations for manipulating files. -- This abstraction builds on the capabilities available from ancestor -- packages. package CA11003_0.CA11003_1.CA11003_2 is procedure News (Mode : in File_Mode; File : out Extended_File_Type); procedure Copy (Original : in Extended_File_Type; Duplicate : out Extended_File_Type); procedure Delete (File : in Extended_File_Type); end CA11003_0.CA11003_1.CA11003_2; -- Grandchild package OS.Operations.Menu --=================================================================-- -- Grandchild subprogram Validate function CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type) return Boolean; --=================================================================-- -- Grandchild subprogram Validate function CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type) -- Parent type. return Boolean is function New_File_Validated (File : Extended_File_Type) return Boolean is begin if (File.Descriptor > System_File.Descriptor) and -- Grandparent (File.Mode in File_Mode ) and -- object and type not ((File.Blocks < System_Extended_File.Blocks) or (File.Blocks > Max_File_Size)) -- Parent object then -- and constant. return True; else return False; end if; end New_File_Validated; begin return (New_File_Validated (File)) and (File.Descriptor /= Null_File); -- Grandparent constant. end CA11003_0.CA11003_1.CA11003_3; -- Grandchild subprogram Validate --=================================================================-- with CA11003_0.CA11003_1.CA11003_3; -- Grandchild package body OS.Operations.Menu package body CA11003_0.CA11003_1.CA11003_2 is procedure News (Mode : in File_Mode; File : out Extended_File_Type) is -- Parent type. begin Create_File (Mode, File); -- Parent subprogram. if not CA11003_0.CA11003_1.CA11003_3 (File) then raise File_Data_Error; -- Grandparent exception. end if; end News; -------------------------------------------------- procedure Copy (Original : in Extended_File_Type; Duplicate : out Extended_File_Type) is begin Duplicate_File (Original, Duplicate); -- Parent subprogram. if Original.Descriptor = Duplicate.Descriptor then raise File_Duplication_Error; -- Parent exception. end if; end Copy; -------------------------------------------------- procedure Delete (File : in Extended_File_Type) is begin Reclaim_File_Descriptor; -- Grandparent end Delete; -- subprogram. end CA11003_0.CA11003_1.CA11003_2; --=================================================================-- with CA11003_0.CA11003_1.CA11003_2; -- Grandchild Pkg OS.Operations.Menu with CA11003_0.CA11003_1.CA11003_3; -- Grandchild Ftn OS.Operations.Validate with Report; procedure CA11003 is package Menu renames CA11003_0.CA11003_1.CA11003_2; begin Report.Test ("CA11003", "Check that a public grandchild can utilize " & "its ancestor unit's visible definitions"); File_Processing: -- Validate all of the capabilities contained in -- the Menu package by exercising them on specific -- files. This will demonstrate the use of child -- and grandchild functionality based on components -- that have been declared in the -- parent/grandparent package. declare function Validate (File : CA11003_0.CA11003_1.Extended_File_Type) return Boolean renames CA11003_0.CA11003_1.CA11003_3; MacWrite_File, Backup_Copy : CA11003_0.CA11003_1.Extended_File_Type; MacWrite_File_Mode : CA11003_0.File_Mode := CA11003_0.Read_Write; begin Menu.News (MacWrite_File_Mode, MacWrite_File); if not Validate (MacWrite_File) then Report.Failed ("Incorrect initialization of files"); end if; Menu.Copy (MacWrite_File, Backup_Copy); if not (Validate (MacWrite_File) and Validate (Backup_Copy)) then Report.Failed ("Incorrect duplication of files"); end if; Menu.Delete (Backup_Copy); exception when CA11003_0.File_Data_Error => Report.Failed ("Exception raised during file validation"); when CA11003_0.CA11003_1.File_Duplication_Error => Report.Failed ("Exception raised during file duplication"); when others => Report.Failed ("Unexpected exception in test procedure"); end File_Processing; Report.Result; end CA11003;