From 8df7ee67f6fdc780e9453f2baa8d1bf62c000761 Mon Sep 17 00:00:00 2001 From: Thomas Koenig 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 PR libfortran/95191 * libgfortran.h (libgfortran_error_codes): Add LIBERROR_BAD_WAIT_ID. libgfortran/ChangeLog: 2020-05-23 Thomas Koenig 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 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 fb0e47c7624..55d5dae3cf5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-05-23 Thomas Koenig + + PR libfortran/95191 + * libgfortran.h (libgfortran_error_codes): Add + LIBERROR_BAD_WAIT_ID. + 2020-05-20 Mark Eggleston PR fortran/39695 diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index d097caa4a96..6a9139c98fc 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 71c233c87d6..ddb1af1721f 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2020-05-23 Thomas Koenig + + 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 * m4/matmul.m4: Don't include . Use diff --git a/libgfortran/io/async.c b/libgfortran/io/async.c index 63b9158c0ba..1bf38e9c0ff 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 9ed5d566eb6..ff6b852a07c 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 5d406191853..a0922a4db39 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,8 @@ +2020-05-23 Thomas Koenig + + PR libfortran/95191 + * testsuite/libgomp.fortran/async_io_9.f90: New test. + 2020-05-19 Jakub Jelinek * 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 00000000000..2dc111c3967 --- /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 -- 2.30.2