[gcc r11-7647] Fortran: Fix libgfortran I/O race with newunit_free [PR99529]

[Tobias Burnus]

https://gcc.gnu.org/g:a6e9633ccb593937fceec67fafc2afe5d518d735

commit r11-7647-ga6e9633ccb593937fceec67fafc2afe5d518d735
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Fri Mar 12 16:31:32 2021 +0100

    Fortran: Fix libgfortran I/O race with newunit_free [PR99529]
    
    libgfortran/ChangeLog:
    
            * io/transfer.c (st_read_done_worker, st_write_done_worker):
            Call unlock_unit here, add unit_lock lock around newunit_free call.
            (st_read_done, st_write_done): Only call unlock_unit when not
            calling the worker function.
            * io/unit.c (set_internal_unit): Don't reset the unit_number
            to the same number as this cause race warnings.

Diff:
---
 libgfortran/io/transfer.c | 32 ++++++++++++++++++++++++--------
 libgfortran/io/unit.c     |  1 -
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 27bee9d4e01..71a935652e3 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -4339,6 +4339,7 @@ export_proto(st_read_done);
 void
 st_read_done_worker (st_parameter_dt *dtp)
 {
+  bool free_newunit = false;
   finalize_transfer (dtp);
 
   free_ionml (dtp);
@@ -4358,7 +4359,7 @@ st_read_done_worker (st_parameter_dt *dtp)
 		free (dtp->u.p.current_unit->ls);
 	      dtp->u.p.current_unit->ls = NULL;
 	    }
-	  newunit_free (dtp->common.unit);
+	  free_newunit = true;
 	}
       if (dtp->u.p.unit_is_internal || dtp->u.p.format_not_saved)
 	{
@@ -4366,6 +4367,14 @@ st_read_done_worker (st_parameter_dt *dtp)
 	  free_format (dtp);
 	}
     }
+   unlock_unit (dtp->u.p.current_unit);
+   if (free_newunit)
+     {
+       /* Avoid inverse lock issues by placing after unlock_unit.  */
+       LOCK (&unit_lock);
+       newunit_free (dtp->common.unit);
+       UNLOCK (&unit_lock);
+     }
 }
 
 void
@@ -4382,11 +4391,10 @@ st_read_done (st_parameter_dt *dtp)
 	      if (dtp->u.p.async)
 		enqueue_done (dtp->u.p.current_unit->au, AIO_READ_DONE);
 	    }
+	  unlock_unit (dtp->u.p.current_unit);
 	}
       else
-	st_read_done_worker (dtp);
-
-      unlock_unit (dtp->u.p.current_unit);
+	st_read_done_worker (dtp);  /* Calls unlock_unit.  */
     }
 
   library_end ();
@@ -4406,6 +4414,7 @@ st_write (st_parameter_dt *dtp)
 void
 st_write_done_worker (st_parameter_dt *dtp)
 {
+  bool free_newunit = false;
   finalize_transfer (dtp);
 
   if (dtp->u.p.current_unit != NULL
@@ -4446,7 +4455,7 @@ st_write_done_worker (st_parameter_dt *dtp)
 		free (dtp->u.p.current_unit->ls);
 	      dtp->u.p.current_unit->ls = NULL;
 	    }
-	  newunit_free (dtp->common.unit);
+	  free_newunit = true;
 	}
       if (dtp->u.p.unit_is_internal || dtp->u.p.format_not_saved)
 	{
@@ -4454,6 +4463,14 @@ st_write_done_worker (st_parameter_dt *dtp)
 	  free_format (dtp);
 	}
     }
+   unlock_unit (dtp->u.p.current_unit);
+   if (free_newunit)
+     {
+       /* Avoid inverse lock issues by placing after unlock_unit.  */
+       LOCK (&unit_lock);
+       newunit_free (dtp->common.unit);
+       UNLOCK (&unit_lock);
+     }
 }
 
 extern void st_write_done (st_parameter_dt *);
@@ -4476,11 +4493,10 @@ st_write_done (st_parameter_dt *dtp)
 	      if (dtp->u.p.async)
 		enqueue_done (dtp->u.p.current_unit->au, AIO_WRITE_DONE);
 	    }
+	  unlock_unit (dtp->u.p.current_unit);
 	}
       else
-	st_write_done_worker (dtp);
-
-      unlock_unit (dtp->u.p.current_unit);
+	st_write_done_worker (dtp);  /* Calls unlock_unit.  */
     }
 
   library_end ();
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 2ea664331bc..b0cc6ab2301 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -456,7 +456,6 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind)
 {
   gfc_offset start_record = 0;
 
-  iunit->unit_number = dtp->common.unit;
   iunit->recl = dtp->internal_unit_len;
   iunit->internal_unit = dtp->internal_unit;
   iunit->internal_unit_len = dtp->internal_unit_len;