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--! 36with Ada.Streams.Stream_Io; 37use Ada.Streams; 38with Ada.Exceptions; 39use Ada.Exceptions; 40with Report; 41use Report; 42procedure 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 269begin 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; 334exception 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 342end CXAC005; 343 344