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

Fortran: Fix runtime segfault closing negative unit

Browse source 
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:
Jerry DeLisle 2025-04-12 19:51:23 -07:00
parent 5869a88144
commit ee6173800e
3 changed files with 36 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/testsuite/gfortran.dg/pr119502.f90 Normal file
View 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

13
libgfortran/io/close.c
View file

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

10
libgfortran/io/open.c
View file

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