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;