gcc/testsuite/ada/acats/tests/cxa/cxa8003.a

   1 -- CXA8003.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 Append_File mode has not been added to package Direct_IO.
  28 --
  29 -- TEST DESCRIPTION:
  30 --      This test uses a procedure to change the mode of an existing Direct_IO
  31 --      file.  The file descriptor is passed as a parameter, along with a
  32 --      numeric indicator for the new mode.  Based on the numeric parameter,
  33 --      a Direct_IO.Reset is performed using a File_Mode'Value transformation
  34 --      of a string constant into a File_Mode value.  An attempt to reset a
  35 --      Direct_IO file to mode Append_File should cause an Constraint_Error
  36 --      to be raised, as Append_File mode has not been added to Direct_IO in
  37 --      Ada 9X.
  38 --
  39 -- APPLICABILITY CRITERIA:
  40 --      This test is applicable to all implementations supporting Direct_IO
  41 --      files.
  42 --
  43 --
  44 -- CHANGE HISTORY:
  45 --      06 Dec 94   SAIC    ACVC 2.0
  46 --      19 Feb 97   PWB.CTA Allowed for non-support of Reset for certain
  47 --                  modes.
  48 --!
  49
  50 with Direct_IO;
  51 with Report;
  52
  53 procedure CXA8003 is
  54    Incomplete : exception;
  55       begin
  56
  57          Report.Test ("CXA8003", "Check that Append_File mode has not " &
  58                                  "been added to package Direct_IO");
  59
  60          Test_for_Direct_IO_Support:
  61          declare
  62
  63             subtype String_Data_Type    is String (1 .. 20);
  64             type    Numeric_Data_Type   is range 1 .. 512;
  65             type    Composite_Data_Type is array (1 .. 3) of String_Data_Type;
  66
  67             type File_Data_Type is record
  68                Data_Field_1 : String_Data_Type;
  69                Data_Field_2 : Numeric_Data_Type;
  70                Data_Field_3 : Composite_Data_Type;
  71             end record;
  72
  73             package Dir_IO is new Direct_IO (File_Data_Type);
  74
  75             Data_File    : Dir_IO.File_Type;
  76             Dir_Filename : constant String := Report.Legal_File_Name;
  77
  78          begin
  79
  80             -- An application creates a text file with mode Out_File.
  81             -- Use_Error will be raised if Direct_IO operations or external
  82             -- files are not supported.
  83
  84             Dir_IO.Create (Data_File,
  85                            Dir_IO.Out_File,
  86                            Dir_Filename);
  87
  88             Change_File_Mode:
  89             declare
  90
  91                TC_Append_Test_Executed : Boolean := False;
  92
  93                type Mode_Selection_Type is ( A, I, IO, O );
  94
  95
  96                procedure Change_Mode (File : in out Dir_IO.File_Type;
  97                                       To   : in     Mode_Selection_Type) is
  98                begin
  99                   case To is
 100                      when A  =>
 101                         TC_Append_Test_Executed := True;
 102                         Dir_IO.Reset
 103                           (File, Dir_IO.File_Mode'Value("Append_File"));
 104                      when I  =>
 105                         begin
 106                           Dir_IO.Reset
 107                             (File, Dir_IO.File_Mode'Value("In_File"));
 108                         exception
 109                           when Dir_IO.Use_Error =>
 110                             Report.Not_Applicable
 111                               ("Reset to In_File not supported: Direct_IO");
 112                             raise Incomplete;
 113                         end;
 114                      when IO =>
 115                         begin
 116                           Dir_IO.Reset
 117                             (File, Dir_IO.File_Mode'Value("Inout_File"));
 118                         exception
 119                           when Dir_IO.Use_Error =>
 120                             Report.Not_Applicable
 121                               ("Reset to InOut_File not supported: Direct_IO");
 122                             raise Incomplete;
 123                         end;
 124                      when O  =>
 125                        begin
 126                          Dir_IO.Reset
 127                            (File, Dir_IO.File_Mode'Value("Out_File"));
 128                         exception
 129                           when Dir_IO.Use_Error =>
 130                             Report.Not_Applicable
 131                               ("Reset to Out_File not supported: Direct_IO");
 132                             raise Incomplete;
 133                         end;
 134                   end case;
 135                end Change_Mode;
 136
 137
 138             begin
 139
 140               -- At some point in the processing, the application may call a
 141               -- procedure to change the mode of the file (perhaps for
 142               -- additional data entry, data verification, etc.).  It is at
 143               -- this point that a use of Append_File mode for a Direct_IO
 144               -- file would cause an exception.
 145
 146                for I in reverse Mode_Selection_Type loop
 147                   Change_Mode (Data_File, I);
 148                   Report.Comment
 149                     ("Mode changed to " &
 150                      Dir_IO.File_Mode'Image (Dir_IO.Mode (Data_File)));
 151                end loop;
 152
 153                Report.Failed("No error raised on change to Append_File mode");
 154
 155             exception
 156
 157                -- A handler has been provided in the application, which
 158                -- handles the constraint error, allowing processing to
 159                -- continue.
 160
 161                when Constraint_Error =>
 162
 163                   if TC_Append_Test_Executed then
 164                      Report.Comment ("Constraint_Error correctly raised on " &
 165                                      "attempted Append_File mode selection " &
 166                                      "for a Direct_IO file");
 167                   else
 168                      Report.Failed ("Append test was not executed");
 169                   end if;
 170
 171                when Incomplete => raise;
 172
 173                when others  => Report.Failed ("Unexpected exception raised");
 174
 175             end Change_File_Mode;
 176
 177             Final_Block:
 178             begin
 179               if Dir_IO.Is_Open (Data_File) then
 180                  Dir_IO.Delete (Data_File);
 181               else
 182                  Dir_IO.Open (Data_File, Dir_IO.In_File, Dir_Filename);
 183                  Dir_IO.Delete (Data_File);
 184               end if;
 185             exception
 186               when others =>
 187                 Report.Failed ("Delete not properly supported: Direct_IO");
 188             end Final_Block;
 189
 190          exception
 191
 192             -- Since Use_Error or Name_Error can be raised if, for the
 193             -- specified mode, the environment does not support Direct_IO
 194             -- operations, the following handlers are included:
 195
 196             when Dir_IO.Name_Error =>
 197                Report.Not_Applicable("Name_Error raised on Direct IO Create");
 198
 199             when Dir_IO.Use_Error  =>
 200                Report.Not_Applicable("Use_Error raised on Direct IO Create");
 201
 202             when others            =>
 203                Report.Failed
 204                  ("Unexpected exception raised on Direct IO Create");
 205
 206          end Test_for_Direct_IO_Support;
 207
 208          Report.Result;
 209
 210 exception
 211   when Incomplete =>
 212     Report.Result;
 213
 214 end CXA8003;