diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 27b1a3ce920..ec62a9581a7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-07-30 Paul Thomas + + PR fortran/22570 an related issues. + * gfortran.dg/x_slash_1.f: New test. + 2005-07-30 Joseph S. Myers PR c/23143 diff --git a/gcc/testsuite/gfortran.dg/x_slash_1.f b/gcc/testsuite/gfortran.dg/x_slash_1.f new file mode 100755 index 00000000000..f4f9ed2281c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/x_slash_1.f @@ -0,0 +1,116 @@ +c { dg-do run } +c This program tests the fixes to PR22570. +c +c Provided by Paul Thomas - pault@gcc.gnu.org +c + program x_slash + character*60 a + character*1 b, c + + open (10, status = "scratch") + +c Check that lines with only x-editing followed by a slash generate +c spaces and that subsequent lines have spaces where they should. +c Line 1 we ignore. +c Line 2 has nothing but x editing, followed by a slash. +c Line 3 has x editing finished off by a 1h* + + write (10, 100) + 100 format (1h1,58x,1h!,/,60x,/,59x,1h*,/) + rewind (10) + + read (10, 200) a + read (10, 200) a + do i = 1,60 + if (ichar(a(i:i)).ne.32) call abort () + end do + read (10, 200) a + 200 format (a60) + do i = 1,59 + if (ichar(a(i:i)).ne.32) call abort () + end do + if (a(60:60).ne."*") call abort () + rewind (10) + +c Check that sequences of t- and x-editing generate the correct +c number of spaces. +c Line 1 we ignore. +c Line 2 has tabs to the right of present position. +c Line 3 has tabs to the left of present position. + + write (10, 101) + 101 format (1h1,58x,1h#,/,t38,2x,1h ,tr10,9x,1h$,/, + > 6habcdef,tl4,2x,6hghijkl,t1,59x,1h*) + rewind (10) + + read (10, 200) a + read (10, 200) a + do i = 1,59 + if (ichar(a(i:i)).ne.32) call abort () + end do + if (a(60:60).ne."$") call abort () + read (10, 200) a + if (a(1:10).ne."abcdghijkl") call abort () + do i = 11,59 + if (ichar(a(i:i)).ne.32) call abort () + end do + if (a(60:60).ne."*") call abort () + rewind (10) + +c Now repeat the first test, with the write broken up into three +c separate statements. This checks that the position counters are +c correctly reset for each statement. + + write (10,102) "#" + write (10,103) + write (10,102) "$" + 102 format(59x,a1) + 103 format(60x) + rewind (10) + read (10, 200) a + read (10, 200) a + read (10, 200) a + do i = 11,59 + if (ichar(a(i:i)).ne.32) call abort () + end do + if (a(60:60).ne."$") call abort () + rewind (10) + +c Next we check multiple read x- and t-editing. +c First, tab to the right. + + read (10, 201) b, c +201 format (tr10,49x,a1,/,/,2x,t60,a1) + if ((b.ne."#").or.(c.ne."$")) call abort () + rewind (10) + +c Now break it up into three reads and use left tabs. + + read (10, 202) b +202 format (10x,tl10,59x,a1) + read (10, 203) +203 format () + read (10, 204) c +204 format (10x,t5,55x,a1) + if ((b.ne."#").or.(c.ne."$")) call abort () + close (10) + +c Now, check that trailing spaces are not transmitted when we have +c run out of data (Thanks to Jack Howarth for finding this one: +c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html). + + open (10, pad = "no", status = "scratch") + b = achar (0) + write (10, 105) 42 + 105 format (i10,1x,i10) + write (10, 106) + 106 format ("============================") + rewind (10) + read (10, 205, iostat = ier) i, b + 205 format (i10,a1) + if ((ier.eq.0).or.(ichar(b).ne.0)) call abort () + +c That's all for now, folks! + + end + diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c068afe57d5..84bcc4843f3 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2005-07-30 Paul Thomas + + PR fortran/22570 and related issues. + * transfer.c (formatted_transfer): Make sure that there + really is data present before X- or T- editing. Move all + treatment of tabbing during writes to start of next data + producing format. Suppress incorrect zeroing of bytes_left + in slash formating. Insert int cast for assignment of a + difference of two gfc_offsets. + 2005-07-23 Jerry DeLisle * io/write.c (write_float): Revise output of IEEE exceptional diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 85d0dd91cfa..357e090f2b7 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -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; }