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 --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 27bee9d4e01d1a1ca2110f9731e66c0e840be85c..71a935652e37bcc9e1bfc4a41f6f9fd3935c1838 100644 (file)
--- 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 2ea664331bc54a6dbc40b9ed596c5fe539b0aa6b..b0cc6ab230142b82d35246445b532143527d821f 100644 (file)
--- 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;