FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fixes a hang on an invalid ID in a WAIT statement.

Browse source 
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.
This commit is contained in:
Thomas Koenig 2020-05-23 19:01:43 +02:00
parent 584d52b088
commit 8df7ee67f6
7 changed files with 50 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -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

1
gcc/fortran/libgfortran.h
View file

@ -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;

7
libgfortran/ChangeLog
View file

@ -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

7
libgfortran/io/async.c
View file

@ -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;

4
libgfortran/runtime/error.c
View file

@ -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;

5
libgomp/ChangeLog
View file

@ -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.

20
libgomp/testsuite/libgomp.fortran/async_io_9.f90 Normal file
View file

@ -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