diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2006-04-13 06:24:58 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2006-04-13 06:24:58 +0000 |
| commit | 6f34d6e078fafa8cdc99a2c3b98d5d8882c62303 (patch) | |
| tree | c763d2334fb0ded7d39d7fef5c1d53dabe519ab2 /libgfortran/io/transfer.c | |
| parent | 7b5d92b270ef6b7a55f4b337ee52777e53695807 (diff) | |
| download | gcc-6f34d6e078fafa8cdc99a2c3b98d5d8882c62303.zip gcc-6f34d6e078fafa8cdc99a2c3b98d5d8882c62303.tar.gz gcc-6f34d6e078fafa8cdc99a2c3b98d5d8882c62303.tar.bz2 | |
re PR fortran/26766 ([F2003] Recursive I/O still (again) broken)
2006-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/26766
* io/io.h: Add bit to identify associated unit as internal.
* io/unit.c (get_external_unit): Renamed the find_unit_1 function to
reflect the external unit functionality vs internal unit.
(get_internal_unit): New function to allocate and initialize an internal
unit structure.
(get_unit): Use get_internal_unit and get_external_unit.
(is_internal_unit): Revised to use new bit added in io.h.
* io/transfer.c (data_transfer_init): Fix line width.
(st_read_done): Free memory allocated for internal unit.
(st_write_done): Add test to only flush and truncate when not an
internal unit. Free memory allocated for internal unit.
From-SVN: r112914
Diffstat (limited to 'libgfortran/io/transfer.c')
| -rw-r--r-- | libgfortran/io/transfer.c | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 6097c35..11be456 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1619,7 +1619,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) it is always safe to truncate the file on the first write */ if (dtp->u.p.mode == WRITING && dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL - && dtp->u.p.current_unit->last_record == 0 && !is_preconnected(dtp->u.p.current_unit->s)) + && dtp->u.p.current_unit->last_record == 0 + && !is_preconnected(dtp->u.p.current_unit->s)) struncate(dtp->u.p.current_unit->s); /* Bugware for badly written mixed C-Fortran I/O. */ @@ -2317,6 +2318,8 @@ st_read_done (st_parameter_dt *dtp) free_mem (dtp->u.p.scratch); if (dtp->u.p.current_unit != NULL) unlock_unit (dtp->u.p.current_unit); + if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL) + free_mem (dtp->u.p.current_unit); library_end (); } @@ -2353,10 +2356,12 @@ st_write_done (st_parameter_dt *dtp) case NO_ENDFILE: /* Get rid of whatever is after this record. */ - flush (dtp->u.p.current_unit->s); - if (struncate (dtp->u.p.current_unit->s) == FAILURE) - generate_error (&dtp->common, ERROR_OS, NULL); - + if (!is_internal_unit (dtp)) + { + flush (dtp->u.p.current_unit->s); + if (struncate (dtp->u.p.current_unit->s) == FAILURE) + generate_error (&dtp->common, ERROR_OS, NULL); + } dtp->u.p.current_unit->endfile = AT_ENDFILE; break; } @@ -2367,6 +2372,8 @@ st_write_done (st_parameter_dt *dtp) free_mem (dtp->u.p.scratch); if (dtp->u.p.current_unit != NULL) unlock_unit (dtp->u.p.current_unit); + if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL) + free_mem (dtp->u.p.current_unit); library_end (); } |