PR fortran/22570 and related issues.
2005-07-30 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. From-SVN: r102583
This commit is contained in:
Paul Thomas
parent
0cbc4d773a
commit
b6f571b7d3
@ -1,3 +1,8 @@
|
||||
2005-07-30 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/22570 an related issues.
|
||||
* gfortran.dg/x_slash_1.f: New test.
|
||||
|
||||
2005-07-30 Joseph S. Myers <joseph@codesourcery.com>
|
||||
|
||||
PR c/23143
|
||||
|
||||
116
gcc/testsuite/gfortran.dg/x_slash_1.f
Executable file
116
gcc/testsuite/gfortran.dg/x_slash_1.f
Executable file
@ -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
|
||||
|
||||
@ -1,3 +1,13 @@
|
||||
2005-07-30 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.
|
||||
|
||||
2005-07-23 Jerry DeLisle <jvdelisle@verizon.net>
|
||||
|
||||
* io/write.c (write_float): Revise output of IEEE exceptional
|
||||
|
||||
@ -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;
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user