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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f50959627f51d6a5a3adac1473a1c400ce920baa..d86bfeb22eb3a8c18158f8565022e2c53a7bd241 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index a56877e2ad63826481ee2ee9ebc1d429c1459f5d..4a8393c00cbf5a0452f0ccbea02c823ad23a4e5b 100644 (file)
--- 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 f3285de6a6c7c842364fb4f79fef5b338a04710e..8d5fff7cf2bfee588e13b051ec34d64b06b7be00 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gnat.dg/test_direct_io.adb b/gcc/testsuite/gnat.dg/test_direct_io.adb
new file mode 100644 (file)
index 0000000..0eb8aa2
--- /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;