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

   1 -- CXAC005.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     The Ada Conformity Assessment Authority (ACAA) holds unlimited
   6 --     rights in the software and documentation contained herein. Unlimited
   7 --     rights are the same as those granted by the U.S. Government for older
   8 --     parts of the Ada Conformity Assessment Test Suite, and are defined
   9 --     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
  10 --     intends to confer upon all recipients unlimited rights equal to those
  11 --     held by the ACAA. These rights include rights to use, duplicate,
  12 --     release or disclose the released technical data and computer software
  13 --     in whole or in part, in any manner and for any purpose whatsoever, and
  14 --     to have or permit others 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 stream file positioning work as specified.  (Defect Report
  28 --    8652/0055).
  29 --
  30 -- CHANGE HISTORY:
  31 --    12 FEB 2001   PHL   Initial version.
  32 --    14 MAR 2001   RLB   Readied for release; fixed Not_Applicable check
  33 --                        to terminate test gracefully.
  34 --
  35 --!
  36 with Ada.Streams.Stream_Io;
  37 use Ada.Streams;
  38 with Ada.Exceptions;
  39 use Ada.Exceptions;
  40 with Report;
  41 use Report;
  42 procedure CXAC005 is
  43
  44     Incomplete : exception;
  45
  46     procedure TC_Assert (Condition : Boolean; Message : String) is
  47     begin
  48         if not Condition then
  49             Failed (Message);
  50         end if;
  51     end TC_Assert;
  52
  53     package Checked_Stream_Io is
  54
  55         type File_Type (Max_Size : Stream_Element_Count) is limited private;
  56         function Stream_Io_File (File : File_Type) return Stream_Io.File_Type;
  57
  58         procedure Create (File : in out File_Type;
  59                           Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
  60                           Name : in String := "";
  61                           Form : in String := "");
  62
  63         procedure Open (File : in out File_Type;
  64                         Mode : in Stream_Io.File_Mode;
  65                         Name : in String;
  66                         Form : in String := "");
  67
  68         procedure Close (File : in out File_Type);
  69         procedure Delete (File : in out File_Type);
  70
  71         procedure Reset (File : in out File_Type;
  72                          Mode : in Stream_Io.File_Mode);
  73         procedure Reset (File : in out File_Type);
  74
  75         procedure Read (File : in out File_Type;
  76                         Item : out Stream_Element_Array;
  77                         Last : out Stream_Element_Offset;
  78                         From : in Stream_Io.Positive_Count);
  79
  80         procedure Read (File : in out File_Type;
  81                         Item : out Stream_Element_Array;
  82                         Last : out Stream_Element_Offset);
  83
  84         procedure Write (File : in out File_Type;
  85                          Item : in Stream_Element_Array;
  86                          To : in Stream_Io.Positive_Count);
  87
  88         procedure Write (File : in out File_Type;
  89                          Item : in Stream_Element_Array);
  90
  91         procedure Set_Index (File : in out File_Type;
  92                              To : in Stream_Io.Positive_Count);
  93
  94         function Index (File : in File_Type) return Stream_Io.Positive_Count;
  95
  96         procedure Set_Mode (File : in out File_Type;
  97                             Mode : in Stream_Io.File_Mode);
  98
  99     private
 100         type File_Type (Max_Size : Stream_Element_Count) is
 101             record
 102                 File : Stream_Io.File_Type;
 103                 Index : Stream_Io.Positive_Count;
 104                 Contents :
 105                    Stream_Element_Array
 106                       (Stream_Element_Offset (Ident_Int (1)) .. Max_Size);
 107             end record;
 108     end Checked_Stream_Io;
 109
 110     package body Checked_Stream_Io is
 111
 112         use Stream_Io;
 113
 114         function Stream_Io_File (File : File_Type) return Stream_Io.File_Type is
 115         begin
 116             return File.File;
 117         end Stream_Io_File;
 118
 119         procedure Create (File : in out File_Type;
 120                           Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
 121                           Name : in String := "";
 122                           Form : in String := "") is
 123         begin
 124             Stream_Io.Create (File.File, Mode, Name, Form);
 125             File.Index := Stream_Io.Index (File.File);
 126             if Mode = Append_File then
 127                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
 128                         "Index /= Size + 1 -- Create - Append_File");
 129             else
 130                 TC_Assert (File.Index = 1, "Index /= 1 -- Create - " &
 131                                            File_Mode'Image (Mode));
 132             end if;
 133         end Create;
 134
 135         procedure Open (File : in out File_Type;
 136                         Mode : in Stream_Io.File_Mode;
 137                         Name : in String;
 138                         Form : in String := "") is
 139         begin
 140             Stream_Io.Open (File.File, Mode, Name, Form);
 141             File.Index := Stream_Io.Index (File.File);
 142             if Mode = Append_File then
 143                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
 144                         "Index /= Size + 1 -- Open - Append_File");
 145             else
 146                 TC_Assert (File.Index = 1, "Index /= 1 -- Open - " &
 147                                            File_Mode'Image (Mode));
 148             end if;
 149         end Open;
 150
 151         procedure Close (File : in out File_Type) is
 152         begin
 153             Stream_Io.Close (File.File);
 154         end Close;
 155
 156         procedure Delete (File : in out File_Type) is
 157         begin
 158             Stream_Io.Delete (File.File);
 159         end Delete;
 160
 161         procedure Reset (File : in out File_Type;
 162                          Mode : in Stream_Io.File_Mode) is
 163         begin
 164             Stream_Io.Reset (File.File, Mode);
 165             File.Index := Stream_Io.Index (File.File);
 166             if Mode = Append_File then
 167                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
 168                         "Index /= Size + 1 -- Reset - Append_File");
 169             else
 170                 TC_Assert (File.Index = 1, "Index /= 1 -- Reset - " &
 171                                            File_Mode'Image (Mode));
 172             end if;
 173         end Reset;
 174
 175         procedure Reset (File : in out File_Type) is
 176         begin
 177             Reset (File, Stream_Io.Mode (File.File));
 178         end Reset;
 179
 180
 181         procedure Read (File : in out File_Type;
 182                         Item : out Stream_Element_Array;
 183                         Last : out Stream_Element_Offset;
 184                         From : in Stream_Io.Positive_Count) is
 185         begin
 186             Set_Index (File, From);
 187             Read (File, Item, Last);
 188         end Read;
 189
 190         procedure Read (File : in out File_Type;
 191                         Item : out Stream_Element_Array;
 192                         Last : out Stream_Element_Offset) is
 193             Index : constant Stream_Element_Offset :=
 194                Stream_Element_Offset (File.Index);
 195         begin
 196             Stream_Io.Read (File.File, Item, Last);
 197             if Last < Item'Last then
 198                 TC_Assert (Item (Item'First .. Last) =
 199                         File.Contents (Index .. Index + Last - Item'First),
 200                         "Incorrect data read from file - 1");
 201                 TC_Assert (Count (Index + Last - Item'First) =
 202                         Stream_Io.Size (File.File),
 203                         "Read stopped before end of file");
 204                 File.Index := Count (Index + Last - Item'First) + 1;
 205             else
 206                 TC_Assert (Item = File.Contents (Index .. Index + Item'Length - 1),
 207                         "Incorrect data read from file - 2");
 208                 File.Index := File.Index + Item'Length;
 209             end if;
 210         end Read;
 211
 212         procedure Write (File : in out File_Type;
 213                          Item : in Stream_Element_Array;
 214                          To : in Stream_Io.Positive_Count) is
 215         begin
 216             Set_Index (File, To);
 217             Write (File, Item);
 218         end Write;
 219
 220         procedure Write (File : in out File_Type;
 221                          Item : in Stream_Element_Array) is
 222             Index : constant Stream_Element_Offset :=
 223                Stream_Element_Offset (File.Index);
 224         begin
 225             Stream_Io.Write (File.File, Item);
 226             File.Contents (Index .. Index + Item'Length - 1) := Item;
 227             File.Index := File.Index + Item'Length;
 228             TC_Assert (File.Index = Stream_Io.Index (File.File),
 229                     "Write failed to move the index");
 230         end Write;
 231
 232         procedure Set_Index (File : in out File_Type;
 233                              To : in Stream_Io.Positive_Count) is
 234         begin
 235             Stream_Io.Set_Index (File.File, To);
 236             File.Index := Stream_Io.Index (File.File);
 237             TC_Assert (File.Index = To, "Set_Index failed");
 238         end Set_Index;
 239
 240         function Index (File : in File_Type) return Stream_Io.Positive_Count is
 241             New_Index : constant Count := Stream_Io.Index (File.File);
 242         begin
 243             TC_Assert (New_Index = File.Index, "Index changed unexpectedly");
 244             return New_Index;
 245         end Index;
 246
 247         procedure Set_Mode (File : in out File_Type;
 248                             Mode : in Stream_Io.File_Mode) is
 249             Old_Index : constant Count := File.Index;
 250         begin
 251             Stream_Io.Set_Mode (File.File, Mode);
 252             File.Index := Stream_Io.Index (File.File);
 253             if Mode = Append_File then
 254                 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
 255                         "Index /= Size + 1 -- Set_Mode - Append_File");
 256             else
 257                 TC_Assert (File.Index = Old_Index, "Set_Mode changed the index");
 258             end if;
 259         end Set_Mode;
 260
 261     end Checked_Stream_Io;
 262
 263     package Csio renames Checked_Stream_Io;
 264
 265     F : Csio.File_Type (100);
 266     S : Stream_Element_Array (1 .. 10);
 267     Last : Stream_Element_Offset;
 268
 269 begin
 270
 271     Test ("CXAC005", "Check that stream file positioning work as specified");
 272
 273     declare
 274         Name : constant String := Legal_File_Name;
 275     begin
 276         begin
 277             Csio.Create (F, Name => Name);
 278         exception
 279             when others =>
 280                 Not_Applicable ("Files not supported - Creation with Out_File for Stream_IO");
 281                 raise Incomplete;
 282         end;
 283
 284         for I in Stream_Element range 1 .. 10 loop
 285             Csio.Write (F, ((1 => I + 2)));
 286         end loop;
 287         Csio.Write (F, (1 .. 15 => 11));
 288         Csio.Write (F, (1 .. 15 => 12), To => 15);
 289
 290         Csio.Reset (F);
 291
 292         for I in Stream_Element range 1 .. 10 loop
 293             Csio.Write (F, (1 => I));
 294         end loop;
 295         Csio.Write (F, (1 .. 15 => 13));
 296         Csio.Write (F, (1 .. 15 => 14), To => 15);
 297         Csio.Write (F, (1 => 90));
 298
 299         Csio.Set_Mode (F, Stream_Io.In_File);
 300
 301         Csio.Read (F, S, Last);
 302         Csio.Read (F, S, Last, From => 3);
 303         Csio.Read (F, S, Last, From => 28);
 304
 305         Csio.Set_Mode (F, Stream_Io.Append_File);
 306         Csio.Write (F, (1 .. 5 => 88));
 307
 308         Csio.Close (F);
 309
 310         Csio.Open (F, Name => Name, Mode => Stream_Io.Append_File);
 311         Csio.Write (F, (1 .. 3 => 33));
 312
 313         Csio.Set_Mode (F, Stream_Io.In_File);
 314         Csio.Read (F, S, Last, From => 20);
 315         Csio.Read (F, S, Last);
 316         Csio.Reset (F, Stream_Io.Out_File);
 317
 318         Csio.Write (F, (1 .. 9 => 99));
 319
 320         -- Check the contents of the entire file.
 321         declare
 322             S : Stream_Element_Array
 323                    (1 .. Stream_Element_Offset
 324                             (Stream_Io.Size (Csio.Stream_Io_File (F))));
 325         begin
 326             Csio.Reset (F, Stream_Io.In_File);
 327             Csio.Read (F, S, Last);
 328         end;
 329
 330         Csio.Delete (F);
 331     end;
 332
 333     Result;
 334 exception
 335    when Incomplete =>
 336       Report.Result;
 337    when E:others     =>
 338       Report.Failed ("Unexpected exception raised - " & Exception_Name (E) &
 339                       " - " & Exception_Message (E));
 340       Report.Result;
 341
 342 end CXAC005;
 343