From 8df7ee67f6fdc780e9453f2baa8d1bf62c000761 Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sat, 23 May 2020 19:01:43 +0200
Subject: [PATCH] Fixes a hang on an invalid ID in a WAIT statement.
gcc/fortran/ChangeLog:
2020-05-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/95191
* libgfortran.h (libgfortran_error_codes): Add
LIBERROR_BAD_WAIT_ID.
libgfortran/ChangeLog:
2020-05-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/95191
* io/async.c (async_wait_id): Generate error if ID is higher
than the highest current ID.
* runtime/error.c (translate_error): Handle LIBERROR_BAD_WAIT_ID.
libgomp/ChangeLog:
2020-05-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/95191
* testsuite/libgomp.fortran/async_io_9.f90: New test.
---
gcc/fortran/ChangeLog | 6 ++++++
gcc/fortran/libgfortran.h | 1 +
libgfortran/ChangeLog | 7 +++++++
libgfortran/io/async.c | 7 +++++++
libgfortran/runtime/error.c | 4 ++++
libgomp/ChangeLog | 5 +++++
.../testsuite/libgomp.fortran/async_io_9.f90 | 20 +++++++++++++++++++
7 files changed, 50 insertions(+)
create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_9.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fb0e47c76246..55d5dae3cf53 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2020-05-23 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR libfortran/95191
+ * libgfortran.h (libgfortran_error_codes): Add
+ LIBERROR_BAD_WAIT_ID.
+
2020-05-20 Mark Eggleston <markeggleston@gcc.gnu.org>
PR fortran/39695
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index d097caa4a969..6a9139c98fc7 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -124,6 +124,7 @@ typedef enum
LIBERROR_SHORT_RECORD,
LIBERROR_CORRUPT_FILE,
LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE. */
+ LIBERROR_BAD_WAIT_ID,
LIBERROR_LAST /* Not a real error, the last error # + 1. */
}
libgfortran_error_codes;
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 71c233c87d6a..ddb1af1721f1 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2020-05-23 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR libfortran/95191
+ * io/async.c (async_wait_id): Generate error if ID is higher
+ than the highest current ID.
+ * runtime/error.c (translate_error): Handle LIBERROR_BAD_WAIT_ID.
+
2020-05-21 H.J. Lu <hongjiu.lu@intel.com>
* m4/matmul.m4: Don't include <config/i386/cpuinfo.h>. Use
diff --git a/libgfortran/io/async.c b/libgfortran/io/async.c
index 63b9158c0ba0..1bf38e9c0ffd 100644
--- a/libgfortran/io/async.c
+++ b/libgfortran/io/async.c
@@ -424,6 +424,13 @@ async_wait_id (st_parameter_common *cmp, async_unit *au, int i)
}
LOCK (&au->lock);
+ if (i > au->id.high)
+ {
+ generate_error_common (cmp, LIBERROR_BAD_WAIT_ID, NULL);
+ UNLOCK (&au->lock);
+ return true;
+ }
+
NOTE ("Waiting for id %d", i);
if (au->id.waiting < i)
au->id.waiting = i;
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 9ed5d566eb6c..ff6b852a07c3 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -660,6 +660,10 @@ translate_error (int code)
p = "Inquire statement identifies an internal file";
break;
+ case LIBERROR_BAD_WAIT_ID:
+ p = "Bad ID in WAIT statement";
+ break;
+
default:
p = "Unknown error code";
break;
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 5d4061918537..a0922a4db39c 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,8 @@
+2020-05-23 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR libfortran/95191
+ * testsuite/libgomp.fortran/async_io_9.f90: New test.
+
2020-05-19 Jakub Jelinek <jakub@redhat.com>
* omp.h.in (omp_uintptr_t): New typedef.
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_9.f90 b/libgomp/testsuite/libgomp.fortran/async_io_9.f90
new file mode 100644
index 000000000000..2dc111c39677
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_9.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR 95191 - this used to hang.
+! Original test case by Bill Long.
+program test
+ real a(10000)
+ integer my_id
+ integer bad_id
+ integer :: iostat
+ character (len=100) :: iomsg
+ data my_id /1/
+ data bad_id /2/
+ a = 1.
+ open (unit=10, file='test.dat', form='unformatted', &
+ & asynchronous='yes')
+ write (unit=10, asynchronous='yes', id=my_id) a
+ iomsg = ""
+ wait (unit=10, id=bad_id, iostat=iostat, iomsg=iomsg)
+ if (iostat == 0 .or. iomsg /= "Bad ID in WAIT statement") stop 1
+ close (unit=10, status='delete')
+end program test
--
GitLab