diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2017-12-14 02:30:49 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2017-12-14 02:30:49 +0000 |
| commit | 606778c6f55c4df1f247097f4b73d2c551ff4889 (patch) | |
| tree | 5f68781b01180ebf39912f3254d5c1028b162c6c /libgfortran/io/transfer.c | |
| parent | e69319afa646a9aba9eac5a8c16f9e7883f210e6 (diff) | |
| download | gcc-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
Diffstat (limited to 'libgfortran/io/transfer.c')
| -rw-r--r-- | libgfortran/io/transfer.c | 17 |
1 files changed, 13 insertions, 4 deletions
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; |