ca11003.a

来自「linux下编程用 编译软件」· A 代码 · 共 291 行

-- 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;