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.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fb0e47c76246d1a7a93a10ecf0b01752290fe986..55d5dae3cf538a774dda913c716fb654220285b9 100644 (file)
--- 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 d097caa4a9696d0a1193a1bfce7992ed1eae016a..6a9139c98fc78b012c0183a1afdb5f30516235bd 100644 (file)
--- 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 71c233c87d6afe2ab56f63481cadf0400e34a025..ddb1af1721f14b8244aa666f1d60573688683616 100644 (file)
--- 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 63b9158c0ba0ee661c3857e8e07acdff235a3ddb..1bf38e9c0ffdb422064b107e9eddf0e07913873c 100644 (file)
--- 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 9ed5d566eb6c265e05a8361dcecaa09ca6fe6f12..ff6b852a07c38dec5384efebbe488ce7b02336c2 100644 (file)
--- 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 5d40619185374a8a6c15ea796c97aad498d60e52..a0922a4db39c3bf1fae6081c3a19d9d0eae7262c 100644 (file)
--- 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 (file)
index 0000000..2dc111c
--- /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