This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, gfortran] pr22570 and related issues.
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Tue, 26 Jul 2005 19:49:36 +0200
- Subject: [patch, gfortran] pr22570 and related issues.
The enclosed patch, testcase and changelog entries, hopefully deal with
the last of the issues arising from the fixes to the NIST triggered bugs
in formatted io.
Thanks to Jack Howarth,
http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html, for pointing out
that there were still trailing spaces getting through, in spite of all
the counter measures. Most of this patch fixes that problem. At the
same time, an incorrect treatment of slash formatting had broken fixed
record length io and the patch fixes that too.
One thing that is apparent from the last couple of weeks is that the
testsuite tends only to test that which was previously broken. Often
this is sufficient. However, with formatted io, it turned out to be too
easy to break that which was previously unbroken; not in small part
becuse there are so many possible variations of what can be done with
formatted io. For this reason, the enclosed test case is rather more
exhaustive than it need be. Something similar is needed for fixed
record length io. In the longer run, there might be some advantage in
modifying the NIST suite to run as part of the gfortran testsuite. The
work required to do this would be perspiration rather than inspiration
based. If it is thought to be useful, we could look into this,
although there are no promises on the timescale.
The patch is regtested (including enclosed testcase) on RH9/Athlon 1700.
It also seems to fix all the problems except that of array internal
files in the NIST suite.
OK to submit the patch to mainline and 4.0?
For the testcase, we invite comments for improvement. If it is felt to
be useful to commit it right away, this can be done.
Regards
Jerry DeLisle and Paul Thomas
2005-07-19 Paul Thomas <pault@gcc.gnu.org>
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.
.
PR fortran/22570 an related issues.
* gfortran.dg/x_slash_1.f: New Test.
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.49
diff -c -3 -p -r1.49 transfer.c
*** gcc/libgfortran/io/transfer.c 22 Jul 2005 14:07:17 -0000 1.49
--- gcc/libgfortran/io/transfer.c 26 Jul 2005 16:41:59 -0000
*************** formatted_transfer (bt type, void *p, in
*** 482,495 ****
/* Now discharge T, TR and X movements to the right. This is delayed
until a data producing format to supress 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
|| t == FMT_STRING))
{
! write_x (skips, pending_spaces);
! max_pos = (int)(current_unit->recl - current_unit->bytes_left);
skips = pending_spaces = 0;
}
--- 482,504 ----
/* Now discharge T, TR and X movements to the right. This is delayed
until a data producing format to supress trailing spaces. */
t = f->format;
! 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))
{
! 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;
}
*************** formatted_transfer (bt type, void *p, in
*** 724,742 ****
/* Writes occur just before the switch on f->format, above, so that
trailing blanks are suppressed. */
! if (skips > 0)
{
! if (g.mode == READING)
{
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;
}
break;
--- 733,751 ----
/* Writes occur just before the switch on f->format, above, so that
trailing blanks are suppressed. */
! 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 -= (gfc_offset)skips;
! skips = pending_spaces = 0;
! }
}
break;
*************** formatted_transfer (bt type, void *p, in
*** 779,785 ****
case FMT_SLASH:
consume_data_flag = 0 ;
skips = pending_spaces = 0;
- current_unit->bytes_left = 0;
next_record (0);
break;
--- 788,793 ----
*************** formatted_transfer (bt type, void *p, in
*** 818,824 ****
if (g.mode == READING)
skips = 0;
! pos = current_unit->recl - current_unit->bytes_left;
max_pos = (max_pos > pos) ? max_pos : pos;
}
--- 826,832 ----
if (g.mode == READING)
skips = 0;
! pos = (int)(current_unit->recl - current_unit->bytes_left);
max_pos = (max_pos > pos) ? max_pos : pos;
}
=========================================================================
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