Subversion Repositories openrisc

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