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:
parent
f5c064ab04
commit
acf6b7ab30
@ -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
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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
|
||||
|
15
gcc/testsuite/gnat.dg/test_direct_io.adb
Normal file
15
gcc/testsuite/gnat.dg/test_direct_io.adb
Normal 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;
|
Loading…
Reference in New Issue
Block a user