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

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

	PR libgfortran/78549
	* io/io.h (newunit_free): Add declaration. Clean some whitespace.
	* io/transfer.c (st_read_done, st_write_done): Call newunit_free.
	* io/unit.c (newunit_free): Change type from static void to void.

From-SVN: r254982

4 files changed, 40 insertions, 25 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 2408451..f37850c 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-11-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/78549
+	* io/io.h (newunit_free): Add declaration. Clean some whitespace.
+	* io/transfer.c (st_read_done, st_write_done): Call newunit_free.
+	* io/unit.c (newunit_free): Change type from static void to void.
+
 2017-11-19  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR fortran/44292
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index d29b112..50db35e 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -760,18 +760,21 @@ internal_proto(find_or_create_unit);
 extern gfc_unit *get_unit (st_parameter_dt *, int);
 internal_proto(get_unit);
 
-extern void unlock_unit (gfc_unit *);
+extern void unlock_unit(gfc_unit *);
 internal_proto(unlock_unit);
 
 extern void finish_last_advance_record (gfc_unit *u);
-internal_proto (finish_last_advance_record);
+internal_proto(finish_last_advance_record);
 
-extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
-internal_proto (unit_truncate);
+extern int unit_truncate(gfc_unit *, gfc_offset, st_parameter_common *);
+internal_proto(unit_truncate);
 
 extern int newunit_alloc (void);
 internal_proto(newunit_alloc);
 
+extern void newunit_free (int);
+internal_proto(newunit_free);
+
 
 /* open.c */
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index c173447..1eb23fb 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -4087,16 +4087,19 @@ st_read_done (st_parameter_dt *dtp)
   if (dtp->u.p.current_unit != NULL
       && dtp->u.p.current_unit->child_dtio == 0)
     {
-      if (is_internal_unit (dtp) &&
-	  (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
-        {
-	  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;
+      if (is_internal_unit (dtp))
+	{
+	  if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+	    {
+	      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;
+	    }
+	  newunit_free (dtp->common.unit);
 	}
       if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
 	{
@@ -4155,16 +4158,19 @@ st_write_done (st_parameter_dt *dtp)
 
       /* If this is a parent WRITE statement we do not need to retain the
 	 internal unit structure for child use.  */
-      if (is_internal_unit (dtp) &&
-	  (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+      if (is_internal_unit (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;
+	  if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+	    {
+	      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;
+	    }
+	  newunit_free (dtp->common.unit);
 	}
       if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
 	{
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index e06867a..e62f9b8 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -89,7 +89,6 @@ static int newunit_size; /* Total number of elements in the newunits array.  */
    units are allocated, above and equal to the LWI there may be both
    allocated and free units. */
 static int newunit_lwi;
-static void newunit_free (int);
 
 /* Unit numbers assigned with NEWUNIT start from here.  */
 #define NEWUNIT_START -10
@@ -911,7 +910,7 @@ newunit_alloc (void)
 /* Free a previously allocated newunit= unit number.  unit_lock must
    be held when calling.  */
 
-static void
+void
 newunit_free (int unit)
 {
   int ind = -unit + NEWUNIT_START;