The attached patch fixes this bug by adding checks for negative unit numbers in CLOSE and OPEN statements.

Regression tested on x86_64_linux_gnu.

OK for trunk

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 --git a/gcc/testsuite/gfortran.dg/pr119502.f90 b/gcc/testsuite/gfortran.dg/pr119502.f90
new file mode 100644
index 00000000000..80d7c610165
--- /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 81223113dc5..41d278c002c 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 06ddf7f4dc2..e9fb0a7b3b0 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)

Reply via email to