re PR libfortran/78549 (Very slow formatted internal file output)

2017-12-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

        PR libgfortran/78549
        * io/inquire.c (inquire_via_unit): Adjust test for existence for
        pre-connected internal units.
        * io/transfer.c (finalize_transfer): When done with a transfer
        to internal units, free the format buffer and close the stream.
        (st_read_done): Delete freeing the stream, now handled using
        sclose in finalize_transfer. (st_write_done): Likewise.
        * io/unit.c (get_unit): Return NULL for special reserved unit
        numbers, signifying not accessible to the user.
        (init_units): Insert the two special internal units into the
        unit treap. This makes these unit structures available without
        further allocations for later use by internal unit I/O. These
        units are automatically deleted by normal program termination.
        * io/unix.c (mem_close): Add a guard check to protect from double free.

From-SVN: r255621

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 55867f02a2d24b8178bd3cd8baace227ea7922b4..ee2f7a6fd2b0b7294281e6b1eca8a13623a63cc9 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,20 @@
+2017-12-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/78549
+       * io/inquire.c (inquire_via_unit): Adjust test for existence for
+       pre-connected internal units.
+       * io/transfer.c (finalize_transfer): When done with a transfer
+       to internal units, free the format buffer and close the stream.
+       (st_read_done): Delete freeing the stream, now handled using
+       sclose in finalize_transfer. (st_write_done): Likewise.
+       * io/unit.c (get_unit): Return NULL for special reserved unit
+       numbers, signifying not accessible to the user.
+       (init_units): Insert the two special internal units into the
+       unit treap. This makes these unit structures available without
+       further allocations for later use by internal unit I/O. These
+       units are automatically deleted by normal program termination.
+       * io/unix.c (mem_close): Add a guard check to protect from double free.
+
 2017-12-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/36313

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 848a08f61571a2561977af8824a7f4e90c7afc4a..6ba1224d77c0e9cf7e0ab4aa3fb08db068fb5592 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -47,7 +47,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u)
     generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);
 
   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
-    *iqp->exist = (u != NULL) || (iqp->common.unit >= 0);
+    *iqp->exist = (u != NULL &&
+                  iqp->common.unit != GFC_INTERNAL_UNIT &&
+                  iqp->common.unit != GFC_INTERNAL_UNIT4)
+               || (iqp->common.unit >= 0);
 
   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
     *iqp->opened = (u != NULL);

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 4d7ca7abf7b8ffea576856ab666b38b9749ff1e9..211dc34975043d562f2bacbc4e5add45b1b6aa06 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -3985,6 +3985,19 @@ finalize_transfer (st_parameter_dt *dtp)
   next_record (dtp, 1);
 
  done:
+
+  if (dtp->u.p.unit_is_internal)
+    {
+      fbuf_destroy (dtp->u.p.current_unit);
+      if (dtp->u.p.current_unit
+         && (dtp->u.p.current_unit->child_dtio  == 0)
+         && dtp->u.p.current_unit->s)
+       {
+         sclose (dtp->u.p.current_unit->s);
+         dtp->u.p.current_unit->s = NULL;
+       }
+    }
+
 #ifdef HAVE_USELOCALE
   if (dtp->u.p.old_locale != (locale_t) 0)
     {
@@ -4094,8 +4107,6 @@ st_read_done (st_parameter_dt *dtp)
            {
              free (dtp->u.p.current_unit->filename);
              dtp->u.p.current_unit->filename = NULL;
-             free (dtp->u.p.current_unit->s);
-             dtp->u.p.current_unit->s = NULL;
              if (dtp->u.p.current_unit->ls)
                free (dtp->u.p.current_unit->ls);
              dtp->u.p.current_unit->ls = NULL;
@@ -4165,8 +4176,6 @@ st_write_done (st_parameter_dt *dtp)
            {
              free (dtp->u.p.current_unit->filename);
              dtp->u.p.current_unit->filename = NULL;
-             free (dtp->u.p.current_unit->s);
-             dtp->u.p.current_unit->s = NULL;
              if (dtp->u.p.current_unit->ls)
                free (dtp->u.p.current_unit->ls);
              dtp->u.p.current_unit->ls = NULL;

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 66cd12dcdcd9f2c0310b2173f5ce9fd2fc950965..2ca8525fbec465f2c62aa5cee84038e0d055154a 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -566,7 +566,11 @@ get_unit (st_parameter_dt *dtp, int do_create)
      is not allowed, such units must be created with
      OPEN(NEWUNIT=...).  */
   if (dtp->common.unit < 0)
-    return get_gfc_unit (dtp->common.unit, 0);
+    {
+      if (dtp->common.unit > NEWUNIT_START) /* Reserved units.  */
+       return NULL;
+      return get_gfc_unit (dtp->common.unit, 0);
+    }
 
   return get_gfc_unit (dtp->common.unit, do_create);
 }
@@ -701,6 +705,9 @@ init_units (void)
 
       __gthread_mutex_unlock (&u->lock);
     }
+  /* The default internal units.  */
+  u = insert_unit (GFC_INTERNAL_UNIT);
+  u = insert_unit (GFC_INTERNAL_UNIT4);
 }
 
 

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 61e9f7997b25819514af546b50aa1d00b1d116f9..a07a3c9cea80c97391bddeeecadc98785efe8e1c 100644 (file)
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -962,8 +962,8 @@ mem_flush (unix_stream *s __attribute__ ((unused)))
 static int
 mem_close (unix_stream *s)
 {
-  free (s);
-
+  if (s)
+    free (s);
   return 0;
 }