with Ada.Streams.Stream_IO; with Ada.Exceptions; with Ada.Text_IO; procedure AI85 is -- Test issues of Ada.Streams.Stream_IO for AI-85. -- Please run this test on any implementations that support stream files -- on any targets that you have access to, and send the results to -- agent@ada-auth.org, along with your name, the compiler version numbers, -- and a description of the target system (especially the operating system). -- -- Note: The test results represent my interpretation of the ARM as -- corrected by Technical Corrigendum 1 (and my interpretation alone), and -- thus a "Failed" result does not necessarily mean that your compiler is -- incorrect. We're equally interested in "Passed" results, as well. -- -- Randy Brukardt, ARG Editor, January 10, 2001 -- (revised January 11-12, 2001). -- Test results package (replace by "Report" in an ACATS test). type Test_Result is (Passed, Failed, Not_Applicable); Current_Result : Test_Result := Passed; procedure Put_Msg (Prefix, Message : in String) is Line_Length : constant Natural := 72 - Prefix'Length; begin if Message'Length < Line_Length then Ada.Text_IO.Put_Line (Prefix & Message); else declare Space_Loc : Natural := 0; begin for I in reverse Message'First .. Message'First + Line_Length - 1 loop if Message(I) = ' ' then Space_Loc := I; exit; end if; end loop; if Space_Loc = 0 then Ada.Text_IO.Put_Line (Prefix & Message); else Ada.Text_IO.Put_Line (Prefix & Message(Message'First..Space_Loc)); for I in Prefix'range loop Ada.Text_IO.Put (' '); end loop; Ada.Text_IO.Put_Line (Message(Space_Loc+1..Message'Last)); end if; end; end if; end Put_Msg; procedure Test (Description : in String) is begin Put_Msg ("--- AI85 - ", Description); end Test; procedure Result is begin case Current_Result is when Passed => Ada.Text_IO.Put_Line ("=== AI85 Passed"); when Failed => Ada.Text_IO.Put_Line ("*** AI85 Failed"); when Not_Applicable => Ada.Text_IO.Put_Line ("+++ AI85 Not applicable"); end case; end Result; procedure Failed (Message : in String) is begin Put_Msg ("** ", Message); Current_Result := Failed; end Failed; procedure Not_Applicable (Message : in String) is begin if Current_Result /= Failed then Current_Result := Not_Applicable; end if; Put_Msg ("++ ", Message); end Not_Applicable; procedure Comment (Message : in String) is begin Put_Msg ("-- ", Message); end Comment; procedure Information (Message : in String) is begin Ada.Text_IO.Put_Line ("-- " & Message); -- Note: We don't break this up, so Exception_Information -- will work right. end Information; -- Make a shorter name for the tested package: package Strm_IO renames Ada.Streams.Stream_IO; -- Test data: File_Contents : array (Strm_IO.Count range 1 .. 40) of Character; File_Length : Strm_IO.Count := 0; File_Name : constant String := "strmtest"; -- A file name that will be used for the test file. This file will -- be written, and should be positionable, if possible. File : Strm_IO.File_Type; Another_File : Strm_IO.File_Type; use type Strm_IO.Count; -- Test subprograms: Abort_Test : exception; -- Some test invariant failed. procedure Write_at_Index (File : in Strm_IO.File_Type; Index : in Strm_IO.Count; Data : in Character; Positioning_OK : in Boolean := False) is -- Write an item at Index, updating the local copy of the data as well. -- Any file positioning has already been accomplished. Positioning of -- the file is OK if Positioning_OK is True. begin if Positioning_OK then if Strm_IO.Index (File) /= Index then Failed ("File index does not match test index - Index=" & Strm_IO.Count'Image(Index) & " File Index=" & Strm_IO.Count'Image(Strm_IO.Index (File))); -- We allow the test to continue here, because some -- implementations have a broken implementation of Index. end if; end if; Character'Write (Strm_IO.Stream(File), Data); if Index > File_Length then File_Length := Index; end if; File_Contents(Index) := Data; end Write_at_Index; procedure Check_File_Contents (File : in out Strm_IO.File_Type; Code : in Character) is -- Check the file contents against the local set. File will have -- mode "In_File" after this check. Data : Character; Any_Errors : Boolean := False; begin begin Strm_IO.Reset (File => File, Mode => Strm_IO.In_File); exception when Info:others => Failed ('(' & Code & ") Unable to reset stream file - " & Ada.Exceptions.Exception_Name(Info)); Information ("Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end; for I in 1 .. File_Length loop Character'Read (Strm_IO.Stream(File), Data); if Data /= File_Contents(I) then Failed ('(' & Code & ") File contents mismatch at " & Strm_IO.Count'Image(I) & "Read='" & Data & "', expected='" & File_Contents(I) & '''); Any_Errors := True; end if; end loop; if Code in '1' .. '9' and (not Any_Errors) then Comment ('(' & Code & ") File contents as expected."); end if; begin if File_Length /= Strm_IO.Size (File) then Failed ('(' & Code & ") File size mismatch " & "Read=" & Strm_IO.Count'Image(Strm_IO.Size (File)) & ", expected=" & Strm_IO.Count'Image(File_Length)); Any_Errors := True; end if; exception when Strm_IO.Use_Error => null; -- Probably not positionable. end; exception when Strm_IO.End_Error => Failed ('(' & Code & ") Read past end of file when " & "checking contents"); when Info:others => Failed ('(' & Code & ") Unable to read stream file - " & Ada.Exceptions.Exception_Name(Info)); Information ("Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end Check_File_Contents; begin Test ("Check issues with Append_File mode, Set_Mode, and positioning " & "for stream files [version 3]."); begin Strm_IO.Create (File => File, Mode => Strm_IO.Out_File, Name => File_Name); Strm_IO.Delete (File); exception when Strm_IO.Name_Error => Not_Applicable ("Unable to create stream file - Name_Error"); Comment ("Please change the test file name to be acceptable on " & "your system and retry the test."); raise Abort_Test; when Strm_IO.Use_Error => Not_Applicable ("Unable to create stream file - Use_Error"); Comment ("Please check the file permissions and/or change the " & "test file name to be acceptable on your system and " & "retry the test."); raise Abort_Test; when Info:others => Not_Applicable ("Unable to create stream file - " & Ada.Exceptions.Exception_Name(Info)); Information ("Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end; declare -- Test information: Current_Position : Strm_IO.Count; Append_Supports_Positioning : Boolean; Out_Supports_Positioning : Boolean; In_Supports_Positioning : Boolean; begin -- OK, we can create a file. Let's start the test: begin Strm_IO.Create (File => File, Mode => Strm_IO.Append_File, Name => File_Name); exception when Strm_IO.Name_Error => Not_Applicable ("Unable to create append stream file - " & "Name_Error"); Comment ("Please change the test file name to be acceptable " & "on your system and retry the test."); raise Abort_Test; when Strm_IO.Use_Error => Not_Applicable ("Unable to create append stream file - " & "Use_Error"); Comment ("Please check the file permissions and/or change " & "the test file name to be acceptable on your " & "system and retry the test."); raise Abort_Test; when Info:others => Not_Applicable ("Unable to create append stream file - " & Ada.Exceptions.Exception_Name(Info)); Information ("Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end; -- Write a few characters: Write_at_Index (File, 1, 'R'); Write_at_Index (File, 2, 'L'); Write_at_Index (File, 3, 'B'); Write_at_Index (File, 4, ' '); Write_at_Index (File, 5, ' '); Current_Position := 6; -- Determine if the append file is positionable: begin if Strm_IO.Index (File) /= Current_Position then Failed ("(1) Wrong position for Append_File mode - position =" & Strm_IO.Count'Image(Strm_IO.Index (File))); end if; Comment ("(1) Stream file in Append_File mode is positionable."); Append_Supports_Positioning := True; exception when Strm_IO.Use_Error => Comment ("(1) Stream file in Append_File mode is NOT" & " positionable."); Append_Supports_Positioning := False; when Info:others => Failed ("(1) Unexpected exception - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); Append_Supports_Positioning := False; end; -- Simulate backing up to make a correction: begin Strm_IO.Set_Index (File, 5); Current_Position := 5; if not Append_Supports_Positioning then Comment ("(2) Weird: Append_File mode supports Set_Index, " & "but not Index."); else Comment ("(2) Expected: Both Set_Index and Index supported."); end if; exception when Strm_IO.Use_Error => if Append_Supports_Positioning then Failed ("(2) Append_File mode supports Index, but not " & "Set_Index."); else Comment ("(2) Expected: Both Set_Index and Index " & "supported."); end if; end; if Append_Supports_Positioning then if Strm_IO.Index (File) /= Current_Position then Failed ("(2A) Set_Index accepted, but position unchanged - position =" & Strm_IO.Count'Image(Strm_IO.Index (File))); Current_Position := Strm_IO.Index (File); end if; end if; -- Continue writing data: if Append_Supports_Positioning and Current_Position = 5 then -- We don't intend to write at the end of the file; check if the -- implementation is using O_APPEND and writes at the end anyway. if Strm_IO.Size (File) /= File_Length or else File_Length /= 5 then Failed ("(2B) File Size incorrect after writes."); end if; Write_at_Index (File, Current_Position, 'S', Positioning_OK => True); if Strm_IO.Size (File) /= File_Length then Failed ("(2C) Set_Index accepted, but file written at end anyway."); Current_Position := Strm_IO.Size (File); -- Repair the file data to reflect what really happened. File_Contents(5) := ' '; File_Contents(6) := 'S'; File_Length := 6; -- else OK. end if; else Write_at_Index (File, Current_Position, 'S', Positioning_OK => Append_Supports_Positioning); end if; Write_at_Index (File, Current_Position + 1, 'T', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 2, 'T', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 3, ' ', Positioning_OK => Append_Supports_Positioning); Current_Position := Current_Position + 4; -- OK, now check results. (This also checks resetting the mode to -- In_File). Check_File_Contents (File, 'A'); -- Check whether the In_File mode is positionable: -- [Note: This check might be questionable; it follows from my -- interpretation of RM A.12.1, as changed by TC1. Whether a file -- a positionable is a property of the external file; Append_File is -- a mode -- a property of the internal file. Thus changing the mode -- cannot change whether a file is positionable. I've marked all -- such checks by "RLBCheck"; I don't think testing for this in the -- ACATS is a good idea even if I'm right - RLB, 2001-01-10.] begin -- RLBCheck. Strm_IO.Set_Index (File, 5); Current_Position := 5; if not Append_Supports_Positioning then -- RLBCheck. Failed ("(3) In_File mode is positionable, but Append_File " & "mode is not."); else Comment ("(3) Same positionability for In_File and " & "Append_File."); end if; exception when Strm_IO.Use_Error => if Append_Supports_Positioning then -- RLBCheck. Failed ("(3) Append_File mode supports positioning, but no " & "positioning in In_File mode."); else Comment ("(3) Same positionability for In_File and " & "Append_File."); end if; end; -- Change the mode back to Append_File: Strm_IO.Set_Mode (File, Strm_IO.Append_File); Current_Position := File_Length + 1; if Append_Supports_Positioning then if Strm_IO.Index (File) /= Current_Position then Current_Position := Strm_IO.Index (File); Failed ("(B) Wrong position for Set_Mode Append_File - " & "position =" & Strm_IO.Count'Image(Current_Position)); end if; end if; -- Write some more: Write_at_Index (File, Current_Position, 'N', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 1, 'H', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 2, 'C', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 3, ' ', Positioning_OK => Append_Supports_Positioning); Current_Position := Current_Position + 4; -- Try setting the mode to Out_File: begin Strm_IO.Set_Mode (File, Strm_IO.Out_File); -- Check that Set_Mode doesn't change the position: begin if Strm_IO.Index (File) /= Current_Position then Failed ("(C) Set_Mode (Out_File) changed the file " & "position to " & Strm_IO.Count'Image(Strm_IO.Index (File))); end if; exception when Strm_IO.Use_Error => null; -- Not positionable (checked below). end; exception when Info:others => Comment ("(C) Cannot Set_Mode to Out_File - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end; -- Check whether we can position in this mode: begin Strm_IO.Set_Index (File, 2); Current_Position := 2; if not Append_Supports_Positioning then -- RLBCheck. Failed ("(4) Out_File mode is positionable, but Append_File " & "mode is not."); -- Note: This behavior might be friendly, but (IMHO) this is -- not allowed by the RM. else Comment ("(4) Same positionability for Out_File and " & "Append_File."); end if; Out_Supports_Positioning := True; exception when Strm_IO.Use_Error => if Append_Supports_Positioning then -- RLBCheck. Failed ("(4) Append_File mode supports positioning, but no " & "positioning in Out_File mode."); else Comment ("(4) Same positionability for Out_File and " & "Append_File."); end if; Out_Supports_Positioning := False; end; -- Write a few more characters: Write_at_Index (File, Current_Position, 'K', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 1, 'B', Positioning_OK => Append_Supports_Positioning); Write_at_Index (File, Current_Position + 2, 'D', Positioning_OK => Append_Supports_Positioning); Current_Position := Current_Position + 3; -- If we can position, check the Set_Mode (In_File) doesn't change the -- current pointer: begin Strm_IO.Set_Mode (File, Strm_IO.In_File); -- Check that Set_Mode doesn't change the position: begin if Strm_IO.Index (File) /= Current_Position then Failed ("(D) Set_Mode (In_File) changed the file " & "position to " & Strm_IO.Count'Image(Strm_IO.Index (File))); end if; exception when Strm_IO.Use_Error => null; -- Not positionable. end; exception when Info:others => Comment ("(D) Cannot Set_Mode to In_File - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); end; -- OK, now check results. Check_File_Contents (File, 'E'); Strm_IO.Close (File); -- Re-open file (with a different file object) and check -- contents again: begin Strm_IO.Open (File => Another_File, Mode => Strm_IO.In_File, Name => File_Name); exception when Info:others => Failed ("(F) Unable to reopen append stream file - " & Ada.Exceptions.Exception_Name(Info)); Information ("Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end; Check_File_Contents (Another_File, '5'); -- Note: This checks AI-85 question 2: does Reset start at the -- beginning of the external file? -- (From here to the following marker is all part of an RLBCheck.) begin Strm_IO.Set_Index (Another_File, 6); if not Append_Supports_Positioning then -- RLBCheck. Failed ("(6) In_File mode is positionable for reopened file, " & "but Append_File mode for original file is not."); -- The external file is the same, positionability should -- not have changed. else Comment ("(6) Same positionability for In_File on reopened " & "file and Append_File on original file."); end if; In_Supports_Positioning := True; exception when Strm_IO.Use_Error => if Append_Supports_Positioning then -- RLBCheck. Failed ("(6) Append_File mode supports positioning, but " & "no positioning in reopened file with In_File mode."); else Comment ("(6) Same positionability for In_File on " & "reopened file and Append_File on original file."); end if; In_Supports_Positioning := False; when Info:others => Failed ("(6) Unexpected exception - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); In_Supports_Positioning := False; end; -- Reset mode to Append_File: begin Strm_IO.Set_Mode (File => Another_File, Mode => Strm_IO.Append_File); exception when Info:others => Comment ("(H) Unable to Set_Mode from In_File to " & "Append_File - exception - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); raise Abort_Test; end; begin Strm_IO.Set_Index (Another_File, 1); if not In_Supports_Positioning then -- RLBCheck. Failed ("(7) Reopened file: In_File mode is not " & "positionable, but Append_File mode is."); -- The external file is the same, positionability should -- not have changed. else Comment ("(7) Same positionability for reopened file " & "with In_File or Append_File mode"); end if; exception when Strm_IO.Use_Error => if In_Supports_Positioning then -- RLBCheck. Failed ("(7) Reopened File: In_File mode supports " & "positioning, but no positioning in Append_File " & "mode."); -- else this exception is expected. else Comment ("(7) Same positionability for reopened file " & "with In_File or Append_File mode"); end if; when Info:others => Failed ("(7) Unexpected exception - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); end; -- (End lengthy RLBCheck.) -- Check that Set_Mode to the current mode works (question 4 of AI-85). begin Strm_IO.Set_Mode (File => Another_File, Mode => Strm_IO.Append_File); begin if Strm_IO.Index (Another_File) /= File_Length + 1 then Failed ("(8) Wrong position for Set_Mode(Append_File) - " & "position =" & Strm_IO.Count'Image(Strm_IO.Index (Another_File))); else Comment ("(8) Set_Mode(Append_File) works."); end if; exception when Strm_IO.Use_Error => if Append_Supports_Positioning then Failed ("(8) Use_Error checking position of " & "Set_Mode(Append_File)"); else Comment ("(8) Unable to check position of " & "Set_Mode(Append_File) - no positioning."); end if; end; exception when Info:others => Comment ("(8) Unable to Set_Mode from Append_File to " & "Append_File - exception - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); end; Strm_IO.Delete (Another_File); -- Clean up after ourselves. exception when Abort_Test => Comment ("Test aborted"); if Strm_IO.Is_Open (File) then Strm_IO.Delete (File); end if; if Strm_IO.Is_Open (Another_File) then Strm_IO.Delete (Another_File); end if; when Info:others => Failed ("Unexpected exception - " & Ada.Exceptions.Exception_Name(Info)); Information (" Additional information: " & Ada.Exceptions.Exception_Information(Info)); if Strm_IO.Is_Open (File) then Strm_IO.Delete (File); end if; if Strm_IO.Is_Open (Another_File) then Strm_IO.Delete (Another_File); end if; end; Result; end AI85;