gcc/testsuite/ada/acats/tests/ca/ca11002.a

   1 -- CA11002.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 child can utilize its parent unit's visible
  28 --      definitions.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a parent package that contains the following: type, object,
  32 --      constant, exception, and subprograms.  Declare a public child unit
  33 --      that utilizes the components found in the visible part of its parent.
  34 --
  35 --      Demonstrate utilization of the following parent components in the
  36 --      child package:
  37 --
  38 --                          Parent
  39 --          Type              X
  40 --          Constant          X
  41 --          Object            X
  42 --          Subprogram        X
  43 --          Exception         X
  44 --
  45 --      This abstraction simulates a portion of a simple operating system.
  46 --
  47 --
  48 -- CHANGE HISTORY:
  49 --      06 Dec 94   SAIC    ACVC 2.0
  50 --
  51 --!
  52
  53 package CA11002_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    Active_Mode  : constant File_Mode       := Read_Write;
  61
  62    type File_Type is
  63      record
  64         Descriptor : File_Descriptor := Null_File;
  65         Mode       : File_Mode       := Default_Mode;
  66      end record;
  67
  68    System_File     : File_Type;
  69    File_Mode_Error : exception;
  70
  71    function Next_Available_File return File_Descriptor;
  72
  73    function Mode_Of_File (File : File_Type) return File_Mode;
  74
  75 end CA11002_0;                            -- Package OS.
  76
  77      --=================================================================--
  78
  79 package body CA11002_0 is                 -- Package body OS.
  80
  81    File_Count : Integer := 0;
  82
  83    function Next_Available_File return File_Descriptor is
  84    begin
  85       File_Count := File_Count + 1;
  86       return (File_Descriptor(File_Count));    -- Type conversion.
  87    end Next_Available_File;
  88    --------------------------------------------------------------
  89    function Mode_Of_File (File : File_Type) return File_Mode is
  90       Mode : File_Mode := File.Mode;
  91    begin
  92       return (Mode);
  93    end Mode_Of_File;
  94
  95 end CA11002_0;                            -- Package body OS.
  96
  97      --=================================================================--
  98
  99 package CA11002_0.CA11002_1 is            -- Child package OS.Operations.
 100
 101    -- Dot qualification of types, objects, etc. from parent is not required
 102    -- in a child unit.
 103
 104    procedure Create_File (Mode : in     File_Mode:= Active_Mode;
 105                           File :    out File_Type);
 106
 107 end CA11002_0.CA11002_1;                  -- Child package OS.Operations.
 108
 109      --=================================================================--
 110
 111 with Report;
 112 package body CA11002_0.CA11002_1 is       -- Child package body OS.Operations.
 113
 114    function New_File_Validated (File : File_Type)        -- Ensure that a newly
 115      return Boolean is                                   -- created file has
 116       Result : Boolean := False;                         -- appropriate values.
 117    begin
 118       if (File.Descriptor > System_File.Descriptor) and  -- Parent object.
 119          (File.Mode  in  File_Mode )                     -- Parent type.
 120       then
 121          Result := True;
 122       end if;
 123
 124       return (Result);
 125
 126    end New_File_Validated;
 127    --------------------------------------------------------------
 128    procedure Create_File
 129      (Mode       : in     File_Mode := Active_Mode;     -- Parent constant.
 130       File       :    out File_Type) is                 -- Parent type.
 131
 132       New_File : File_Type;
 133
 134    begin
 135       New_File.Descriptor := Next_Available_File;       -- Parent subprogram.
 136       New_File.Mode       := Mode;
 137
 138       if New_File_Validated (File => New_File) then
 139          File := New_File;
 140       end if;
 141
 142    end Create_File;
 143
 144 end CA11002_0.CA11002_1;                  -- Child Package body OS.Operations.
 145
 146      --=================================================================--
 147
 148 -- Child library subprogram Convert_File_Mode specification.
 149 procedure CA11002_0.CA11002_2 (File     : in out File_Type;    -- Parent type.
 150                                New_Mode : in     File_Mode);   -- Parent type.
 151
 152
 153      --=================================================================--
 154 with Report;
 155
 156 -- Child library subprogram Convert_File_Mode body.
 157 procedure CA11002_0.CA11002_2 (File     : in out File_Type;
 158                                New_Mode : in     File_Mode) is
 159 begin
 160    if File.Mode = New_Mode then
 161       raise File_Mode_Error;                               -- Parent exception.
 162       Report.Failed ("Exception not raised in child unit");
 163    else
 164       File.Mode := New_Mode;
 165    end if;
 166 end CA11002_0.CA11002_2;
 167
 168      --=================================================================--
 169
 170 with Report;
 171 with CA11002_0.CA11002_1;          -- Child package OS.Operations.
 172 with CA11002_0.CA11002_2;          -- Child subprogram OS.Convert_File_Mode,
 173                                    -- Implicitly with parent, OS.
 174 use CA11002_0;                     -- All user-defined operators directly
 175                                    -- visible.
 176 procedure CA11002 is
 177 begin
 178
 179    Report.Test ("CA11002", "Check that a public child can utilize its " &
 180                 "parent unit's visible definitions");
 181
 182    File_Creation:                   -- This processing block will demonstrate
 183                                     -- use of child package subroutine that
 184                                     -- takes advantage of components declared
 185                                     -- in the parent package.
 186    declare
 187       User_File : File_Type;
 188    begin
 189       CA11002_0.CA11002_1.Create_File (File => User_File); -- Default mode
 190                                                            -- parameter used in
 191                                                            -- this call.
 192       if (User_File.Descriptor = System_File.Descriptor) or
 193          (User_File.Mode       = Default_Mode)
 194       then
 195          Report.Failed ("Incorrect file creation");
 196       end if;
 197
 198    end File_Creation;
 199
 200    --------------------------------------------------------------
 201    File_Mode_Conversion:            -- This processing block will demonstrate
 202                                     -- the occurrence of a (forced) exception
 203                                     -- being raised in a child subprogram, and
 204                                     -- propagated to the caller.  The exception
 205                                     -- is handled, and the child subprogram
 206                                     -- is called again, this time to perform
 207                                     -- without error.
 208    declare
 209       procedure Convert_File_Mode (File : in out File_Type;
 210         New_Mode : in File_Mode) renames CA11002_0.CA11002_2;
 211       New_File : File_Type;
 212    begin                               -- Raise an exception with this
 213                                        -- illegal conversion operation
 214                                        -- (attempt to change to current mode).
 215
 216       Convert_File_Mode (File     => New_File,
 217                          New_Mode => Default_Mode);
 218       Report.Failed ("Exception should have been raised in child unit");
 219
 220    exception
 221       when File_Mode_Error =>          -- Perform the conversion again, this
 222                                        -- time with a different file mode.
 223
 224          Convert_File_Mode (File     => New_File,
 225                             New_Mode => CA11002_0.Active_Mode);
 226
 227          if New_File.Mode /= Read_Write then
 228             Report.Failed ("Incorrect result from mode conversion operation");
 229          end if;
 230
 231       when others =>
 232          Report.Failed ("Unexpected exception raised in File_Mode_Conversion");
 233
 234    end File_Mode_Conversion;
 235
 236    Report.Result;
 237
 238 end CA11002;