re PR ada/22255 (Reset on shared file causes Use_Error.)

gcc/ada/
	PR ada/22255
	* s-fileio.adb (Reset): Do not raise Use_Error if mode isn't changed.

    gcc/testsuite/
	PR ada/22255
	* gnat.dg/test_direct_io.adb: New file.

From-SVN: r132708
This commit is contained in:
Samuel Tardieu 2008-02-27 12:12:14 +00:00 committed by Samuel Tardieu
parent f5c064ab04
commit acf6b7ab30
4 changed files with 33 additions and 6 deletions

View File

@ -1,3 +1,8 @@
2008-02-27 Samuel Tardieu <sam@rfc1149.net>
PR ada/22255
* s-fileio.adb (Reset): Do not raise Use_Error if mode isn't changed.
2008-02-27 Samuel Tardieu <sam@rfc1149.net>
PR ada/34799

View File

@ -1074,13 +1074,15 @@ package body System.File_IO is
begin
Check_File_Open (File);
-- Change of mode not allowed for shared file or file with no name
-- or file that is not a regular file, or for a system file.
-- Change of mode not allowed for shared file or file with no name or
-- file that is not a regular file, or for a system file. Note that we
-- allow the "change" of mode if it is not in fact doing a change.
if File.Shared_Status = Yes
or else File.Name'Length <= 1
or else File.Is_System_File
or else not File.Is_Regular_File
if Mode /= File.Mode
and then (File.Shared_Status = Yes
or else File.Name'Length <= 1
or else File.Is_System_File
or else not File.Is_Regular_File)
then
raise Use_Error;

View File

@ -1,3 +1,8 @@
2008-02-27 Samuel Tardieu <sam@rfc1149.net>
PR ada/22255
* gnat.dg/test_direct_io.adb: New file.
2008-02-27 Samuel Tardieu <sam@rfc1149.net>
PR ada/34799

View File

@ -0,0 +1,15 @@
-- { dg-do run }
with Ada.Direct_IO;
procedure Test_Direct_IO is
package BDIO is new Ada.Direct_IO (Boolean);
use BDIO;
FD : File_Type;
begin
Create (FD, Form => "shared=yes");
Reset (FD);
Close (FD);
end Test_Direct_IO;