Hi,
I just committed as obvious a patch which fixed a hang on close
with -pthread after a previous error on close with an invalid
STATUS. The solution was obvious: Return early if an error
occurred.
I also managed to make some double ChangeLog entries (fixed with the
next commit after), but hey - git doing strange and unforseen stuff
is par for the course. My life has gotten a lot easier since I stopped
worrying about that kind of stuff.
I will also backport to the other affected branches.
Regards
Thomas
Add early return for invalid STATUS for close.
2020-05-14 Thomas Koenig <tkoe...@gcc.gnu.org>
PR libfortran/95119
* io/close.c (close_status): Add CLOSE_INVALID.
(st_close): Return early on invalid STATUS parameter.
2020-05-14 Thomas Koenig <tkoe...@gcc.gnu.org>
PR libfortran/95119
* testsuite/libgomp.fortran/close_errors_1.f90: New test.
diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 8aaa00393e7..17e064ba4e8 100644
--- a/libgfortran/io/close.c
+++ b/libgfortran/io/close.c
@@ -31,7 +31,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#endif
typedef enum
-{ CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED }
+{ CLOSE_INVALID = - 1, CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED }
close_status;
static const st_option status_opt[] = {
@@ -61,6 +61,12 @@ st_close (st_parameter_close *clp)
find_option (&clp->common, clp->status, clp->status_len,
status_opt, "Bad STATUS parameter in CLOSE statement");
+ if (status == CLOSE_INVALID)
+ {
+ library_end ();
+ return;
+ }
+
u = find_unit (clp->common.unit);
if (ASYNC_IO && u && u->au)
diff --git a/libgomp/testsuite/libgomp.fortran/close_errors_1.f90 b/libgomp/testsuite/libgomp.fortran/close_errors_1.f90
new file mode 100644
index 00000000000..6edb7da4116
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/close_errors_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR 95115 - this used to hang with -pthread. Original test case by
+! Bill Long.
+
+program test
+ character(len=16) my_status
+ character(len=1000) :: iomsg
+ open (unit=10, file='test.dat')
+ print *,42
+ write (10, *) 'weird'
+ rewind (10)
+ read (10, *) my_status
+ close (10)
+ open (unit=10, file='test.dat')
+ close (unit=10, status=my_status, iostat=ios, iomsg=iomsg)
+ if (ios == 0) stop 1
+ if (iomsg /= "Bad STATUS parameter in CLOSE statement") stop 2
+ close (10, status='delete')
+end program test
