diff options
Diffstat (limited to 'libgfortran/io/transfer.c')
| -rw-r--r-- | libgfortran/io/transfer.c | 62 |
1 files changed, 38 insertions, 24 deletions
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 85d0dd91cfa..c7d53ee7cd8 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -25,8 +25,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Libgfortran; see the file COPYING. If not, write to -the Free Software Foundation, 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ /* transfer.c -- Top level handling of data transfer statements. */ @@ -480,16 +480,25 @@ formatted_transfer (bt type, void *p, int len) return; /* No data descriptors left (already raised). */ /* Now discharge T, TR and X movements to the right. This is delayed - until a data producing format to supress trailing spaces. */ + until a data producing format to suppress trailing spaces. */ t = f->format; - if (g.mode == WRITING && skips > 0 - && (t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z - || t == FMT_F || t == FMT_E || t == FMT_EN || t == FMT_ES - || t == FMT_G || t == FMT_L || t == FMT_A || t == FMT_D + if (g.mode == WRITING && skips != 0 + && ((n>0 && ( t == FMT_I || t == FMT_B || t == FMT_O + || t == FMT_Z || t == FMT_F || t == FMT_E + || t == FMT_EN || t == FMT_ES || t == FMT_G + || t == FMT_L || t == FMT_A || t == FMT_D)) || t == FMT_STRING)) { - write_x (skips, pending_spaces); - max_pos = (int)(current_unit->recl - current_unit->bytes_left); + if (skips > 0) + { + write_x (skips, pending_spaces); + max_pos = (int)(current_unit->recl - current_unit->bytes_left); + } + if (skips < 0) + { + move_pos_offset (current_unit->s, skips); + current_unit->bytes_left -= (gfc_offset)skips; + } skips = pending_spaces = 0; } @@ -724,19 +733,19 @@ formatted_transfer (bt type, void *p, int len) /* Writes occur just before the switch on f->format, above, so that trailing blanks are suppressed. */ - if (skips > 0) + if (g.mode == READING) { - if (g.mode == READING) + if (skips > 0) { f->u.n = skips; read_x (f); } - } - if (skips < 0) - { - move_pos_offset (current_unit->s, skips); - current_unit->bytes_left -= skips; - skips = pending_spaces = 0; + if (skips < 0) + { + move_pos_offset (current_unit->s, skips); + current_unit->bytes_left -= (gfc_offset)skips; + skips = pending_spaces = 0; + } } break; @@ -779,7 +788,6 @@ formatted_transfer (bt type, void *p, int len) case FMT_SLASH: consume_data_flag = 0 ; skips = pending_spaces = 0; - current_unit->bytes_left = 0; next_record (0); break; @@ -818,7 +826,7 @@ formatted_transfer (bt type, void *p, int len) if (g.mode == READING) skips = 0; - pos = current_unit->recl - current_unit->bytes_left; + pos = (int)(current_unit->recl - current_unit->bytes_left); max_pos = (max_pos > pos) ? max_pos : pos; } @@ -1020,7 +1028,9 @@ data_transfer_init (int read_flag) { current_unit->recl = file_length(current_unit->s); if (g.mode==WRITING) - empty_internal_buffer (current_unit->s); + empty_internal_buffer (current_unit->s); + else + current_unit->bytes_left = current_unit->recl; } /* Check the action. */ @@ -1163,7 +1173,7 @@ data_transfer_init (int read_flag) it is always safe to truncate the file on the first write */ if (g.mode == WRITING && current_unit->flags.access == ACCESS_SEQUENTIAL - && current_unit->current_record == 0) + && current_unit->last_record == 0) struncate(current_unit->s); current_unit->mode = g.mode; @@ -1526,12 +1536,16 @@ finalize_transfer (void) data transfer, it just updates the length counter. */ static void -iolength_transfer (bt type __attribute__ ((unused)), - void *dest __attribute__ ((unused)), +iolength_transfer (bt type , void *dest __attribute__ ((unused)), int len) { if (ioparm.iolength != NULL) - *ioparm.iolength += len; + { + if (type == BT_COMPLEX) + *ioparm.iolength += 2*len; + else + *ioparm.iolength += len; + } } |