https://gcc.gnu.org/g:ee6173800ed1f9b653a85019ad2fa8e6d883823a
commit r15-9415-gee6173800ed1f9b653a85019ad2fa8e6d883823a
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Sat Apr 12 19:51:23 2025 -0700
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.
Diff:
---
gcc/testsuite/gfortran.dg/pr119502.f90 | 15 +++++++++++++++
libgfortran/io/close.c | 13 +++++++++++--
libgfortran/io/open.c | 10 ++++++++++
3 files changed, 36 insertions(+), 2 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/pr119502.f90
b/gcc/testsuite/gfortran.dg/pr119502.f90
new file mode 100644
index 000000000000..80d7c6101656
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr119502.f90
@@ -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
+
diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 81223113dc5d..41d278c002c6 100644
--- a/libgfortran/io/close.c
+++ b/libgfortran/io/close.c
@@ -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)
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 06ddf7f4dc28..e9fb0a7b3b05 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -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)
