aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io/inquire.c
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 /libgfortran/io/inquire.c
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
Diffstat (limited to 'libgfortran/io/inquire.c')
-rw-r--r--libgfortran/io/inquire.c5
1 files changed, 4 insertions, 1 deletions
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);