mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-21 14:30:59 +08:00
Fortran: Fix runtime segfault closing negative unit
When closing a UNIT with an invalid negative unit number, a segfault ensued. This patch adds checks for these conditions and issues errors. PR libfortran/119502 libgfortran/ChangeLog: * io/close.c (st_close): Issue an error and avoid calling close_share when there is no stream assigned. * io/open.c (st_open): If there is no stream assigned to the unit, unlock the unit and issue an error. gcc/testsuite/ChangeLog: * gfortran.dg/pr119502.f90: New test.
This commit is contained in:
parent
5869a88144
commit
ee6173800e
15
gcc/testsuite/gfortran.dg/pr119502.f90
Normal file
15
gcc/testsuite/gfortran.dg/pr119502.f90
Normal file
@ -0,0 +1,15 @@
|
||||
! { dg-do run }
|
||||
|
||||
! PR119502, negative unit numbers are not allowed without using NEWUNIT
|
||||
|
||||
program foo
|
||||
integer :: iun = -1
|
||||
integer :: ios
|
||||
open (iun, iostat=ios)
|
||||
if (ios == 0) stop 1
|
||||
write(iun,*, iostat=ios) "This is a test."
|
||||
if (ios == 0) stop 2
|
||||
close (iun, iostat=ios)
|
||||
if (ios == 0) stop 3
|
||||
end
|
||||
|
@ -84,8 +84,17 @@ st_close (st_parameter_close *clp)
|
||||
|
||||
if (u != NULL)
|
||||
{
|
||||
if (close_share (u) < 0)
|
||||
generate_error (&clp->common, LIBERROR_OS, "Problem in CLOSE");
|
||||
if (u->s == NULL)
|
||||
{
|
||||
if (u->unit_number < 0)
|
||||
generate_error (&clp->common, LIBERROR_BAD_UNIT,
|
||||
"Unit number is negative with no associated file");
|
||||
library_end ();
|
||||
return;
|
||||
}
|
||||
else
|
||||
if (close_share (u) < 0)
|
||||
generate_error (&clp->common, LIBERROR_OS, "Problem in CLOSE");
|
||||
if (u->flags.status == STATUS_SCRATCH)
|
||||
{
|
||||
if (status == CLOSE_KEEP)
|
||||
|
@ -912,6 +912,16 @@ st_open (st_parameter_open *opp)
|
||||
library_end ();
|
||||
return;
|
||||
}
|
||||
|
||||
if (u->s == NULL)
|
||||
{
|
||||
unlock_unit (u);
|
||||
generate_error (&opp->common, LIBERROR_BAD_OPTION,
|
||||
"Unit number is negative and unit was not already "
|
||||
"opened with OPEN(NEWUNIT=...)");
|
||||
library_end ();
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
if (u == NULL)
|
||||
|
Loading…
x
Reference in New Issue
Block a user