[gcc r16-9253] fortran: [PR126116] Internal file I/O corrupts NEWUNIT state

https://gcc.gnu.org/g:3cf9262ae2c9cbefd40f2f9da0258b79c7f749af

commit r16-9253-g3cf9262ae2c9cbefd40f2f9da0258b79c7f749af
Author: Jerry DeLisle <[email protected]>
Date:   Wed Jul 8 10:22:04 2026 -0700

    fortran: [PR126116] Internal file I/O corrupts NEWUNIT state
    
    Before this fix, Performing an internal file I/O
    (such as WRITE to a character variable) incorrectly corrupts
    the internal unit management table in libgfortran.
    
    This patch adds a bool to the gfc_unit structure to allow
    tracking whether a gfc_unit was created for purposes of
    internal I/O to avoid the breakage.
    
            PR libfortran/126116
    
    libgfortran/ChangeLog:
    
            * io/io.h (struct gfc_unit): Add bool for tracking.
            Fix some white space problems.
            * io/unit.c (close_unit_1): Add a declaration for this
            function so it can be called before it has been defined.
            Use the new bool.
            (is_internal_reserved): New helper function. Returns true
            only if the unit is not null and the internal unit kind is zero
            meaning its not a character string.
            (find_unit): Use the new helper function
            (find_or_create_unit): Use the new helper.
            (get_unit): Set the new bool.
            (close_unit): Update the close_unit_1 argument list.
            (close_units): Likewise.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pr126116.f90: New test.
    
    (cherry picked from commit 11be877aea73b0b26638078908a42dd0f97d81d7)

Diff:
---
 gcc/testsuite/gfortran.dg/pr126116.f90 | 19 ++++++++++++++++
 libgfortran/io/io.h                    | 13 ++++++-----
 libgfortran/io/unit.c                  | 41 +++++++++++++++++++++++++++++-----
 3 files changed, 62 insertions(+), 11 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/pr126116.f90 b/gcc/testsuite/gfortran.dg/pr126116.f90
new file mode 100644
index 000000000000..420584e07dfd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr126116.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+
+program check
+    implicit none
+    integer :: u
+    character(50) :: chr
+
+    ! 1. Correctly generate a negative unit via NEWUNIT
+    open(file="test.txt", newunit=u) ! u gets -10
+    close(u) ! u (-10) is now closed and free
+
+    ! 2. Internal I/O corrupts the state of unit -10
+    write(chr, *) "test"
+
+    ! 3. Redundant CLOSE on the valid unit 'u'.
+    ! This should be a safe no-op according to the standard,
+    ! but it triggers the runtime error/segfault!
+    close(u)
+end program
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 7928c196f63f..f4ec625570d6 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -534,7 +534,7 @@ typedef struct st_parameter_dt
 	     character string is being read so don't use commas to shorten a
 	     formatted field width.  */
 	  unsigned sf_read_comma : 1;
-	  /* A namelist specific flag used to enable reading input from 
+	  /* A namelist specific flag used to enable reading input from
 	     line_buffer for logical reads.  */
 	  unsigned line_buffer_enabled : 1;
 	  /* An internal unit specific flag used to identify that the associated
@@ -648,7 +648,7 @@ typedef struct gfc_unit
 {
   int unit_number;
   stream *s;
-  
+
   /* Treap links.  */
   struct gfc_unit *left, *right;
   int priority;
@@ -705,10 +705,10 @@ typedef struct gfc_unit
 
   /* The format hash table.  */
   struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
-  
+
   /* Formatting buffer.  */
   struct fbuf *fbuf;
-  
+
   /* Function pointer, points to list_read worker functions.  */
   int (*next_char_fn_ptr) (st_parameter_dt *);
   void (*push_char_fn_ptr) (st_parameter_dt *, int);
@@ -719,6 +719,9 @@ typedef struct gfc_unit
   gfc_array_char *string_unit_desc;
   int internal_unit_kind;
 
+  /* Track when a gfc_unit is reserved for an internal unit.  */
+  bool internal_reserved;
+
   /* DTIO Parent/Child procedure, 0 = parent, >0 = child level.  */
   int child_dtio;
 
@@ -1013,7 +1016,7 @@ predec_waiting_locked (gfc_unit *u)
 
      if (predec_waiting_locked (u) == 0)
          // destroy u
-	 
+
      could be further optimized by making this be an __ATOMIC_RELEASE,
      and then inserting a
 
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index fac24db014dc..5973cef108ce 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -478,17 +478,45 @@ found:
 }
 
 
+static int close_unit_1 (gfc_unit *, int, bool);
+
+
+/*  Helper to check if an internal unit is reserved.  */
+
+static inline bool
+is_internal_reserved (gfc_unit *u)
+{
+  return u->internal_reserved && u->internal_unit_kind == 0;
+}
+
+
 gfc_unit *
 find_unit (int n)
 {
-  return get_gfc_unit (n, 0);
+  gfc_unit *u = get_gfc_unit (n, 0);
+
+  if (u != NULL && is_internal_reserved (u))
+    {
+      unlock_unit (u);
+      return NULL;
+    }
+
+  return u;
 }
 
 
 gfc_unit *
 find_or_create_unit (int n)
 {
-  return get_gfc_unit (n, 1);
+  gfc_unit *u = get_gfc_unit (n, 1);
+
+  if (u != NULL && is_internal_reserved (u))
+    {
+      close_unit_1 (u, 0, false);
+      u = get_gfc_unit (n, 1);
+    }
+
+  return u;
 }
 
 
@@ -624,6 +652,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
       dtp->u.p.unit_is_internal = 1;
       dtp->common.unit = newunit_alloc ();
       unit = get_gfc_unit (dtp->common.unit, do_create);
+      unit->internal_reserved = true;
       set_internal_unit (dtp, unit, kind);
       fbuf_init (unit, 128);
       return unit;
@@ -786,7 +815,7 @@ init_units (void)
 
 
 static int
-close_unit_1 (gfc_unit *u, int locked)
+close_unit_1 (gfc_unit *u, int locked, bool free_newunit)
 {
   int i, rc;
 
@@ -816,7 +845,7 @@ close_unit_1 (gfc_unit *u, int locked)
   free_format_hash_table (u);
   fbuf_destroy (u);
 
-  if (u->unit_number <= NEWUNIT_START)
+  if (free_newunit && u->unit_number <= NEWUNIT_START)
     newunit_free (u->unit_number);
 
   if (!locked)
@@ -852,7 +881,7 @@ unlock_unit (gfc_unit *u)
 int
 close_unit (gfc_unit *u)
 {
-  return close_unit_1 (u, 0);
+  return close_unit_1 (u, 0, true);
 }
 
 
@@ -868,7 +897,7 @@ close_units (void)
 {
   WRLOCK (&unit_rwlock);
   while (unit_root != NULL)
-    close_unit_1 (unit_root, 1);
+    close_unit_1 (unit_root, 1, true);
   RWUNLOCK (&unit_rwlock);
 
   free (newunits);