diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 16 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/test_direct_io.adb | 15 |
4 files changed, 34 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f50959627f5..d86bfeb22eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 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 * sem_ch13.adb (Analyze_Record_Representation_Clause): Check that underlying type is present. diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index a56877e2ad6..4a8393c00cb 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -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. - - if File.Shared_Status = Yes - or else File.Name'Length <= 1 - or else File.Is_System_File - or else not File.Is_Regular_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 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f3285de6a6c..8d5fff7cf2b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 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 * gnat.dg/specs/pr34799.ads: New test. diff --git a/gcc/testsuite/gnat.dg/test_direct_io.adb b/gcc/testsuite/gnat.dg/test_direct_io.adb new file mode 100644 index 00000000000..0eb8aa20808 --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_direct_io.adb @@ -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; |