aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJerry DeLisle <jvdelisle@gcc.gnu.org>2017-12-14 02:30:49 +0000
committerJerry DeLisle <jvdelisle@gcc.gnu.org>2017-12-14 02:30:49 +0000
commit606778c6f55c4df1f247097f4b73d2c551ff4889 (patch)
tree5f68781b01180ebf39912f3254d5c1028b162c6c
parente69319afa646a9aba9eac5a8c16f9e7883f210e6 (diff)
downloadgcc-606778c6f55c4df1f247097f4b73d2c551ff4889.zip
gcc-606778c6f55c4df1f247097f4b73d2c551ff4889.tar.gz
gcc-606778c6f55c4df1f247097f4b73d2c551ff4889.tar.bz2
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
-rw-r--r--libgfortran/ChangeLog17
-rw-r--r--libgfortran/io/inquire.c5
-rw-r--r--libgfortran/io/transfer.c17
-rw-r--r--libgfortran/io/unit.c9
-rw-r--r--libgfortran/io/unix.c4
5 files changed, 44 insertions, 8 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 55867f0..ee2f7a6 100644
--- 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 848a08f..6ba1224 100644
--- 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 4d7ca7a..211dc34 100644
--- 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 66cd12d..2ca8525 100644
--- 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 61e9f79..a07a3c9 100644
--- 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;
}