re PR libfortran/14897 ('T' edit descriptor output incorrect)

2004-06-09  Bud Davis  <bdavis9659@comcast.net>

	PR gfortran/14897
	* gfortran.fortran-torture/execute/t_edit.f90

 	* io/transfer.c (formatted_transfer): position is unique
         for T and TL edit descriptors.
 	(data_transfer_init): set record length to size of internal
         file.

From-SVN: r82808
This commit is contained in:
Bud Davis 2004-06-09 01:03:02 +00:00
parent 31b6f11ab0
commit 898c05b8bd
4 changed files with 41 additions and 9 deletions

View File

@ -1,3 +1,8 @@
2004-06-09 Bud Davis <bdavis9659@comcast.net>
PR gfortran/14897
* gfortran.fortran-torture/execute/t_edit.f90
2004-06-09 Bud Davis <bdavis9659@comcast.net>
PR gfortran/15755

View File

@ -0,0 +1,11 @@
!pr 14897 T edit descriptor broken
implicit none
character*80 line
WRITE(line,'(T5,A,T10,A,T15,A)')'AA','BB','CC'
if (line.ne.' AA BB CC ') call abort
WRITE(line,'(5HAAAAA,TL4,4HABCD)')
if (line.ne.'AABCD') call abort
END

View File

@ -1,3 +1,11 @@
2004-06-09 Bud Davis <bdavis9659@comcaste.net>
PR gfortran/14897
* io/transfer.c (formatted_transfer): position is unique
for T and TL edit descriptors.
(data_transfer_init): set record length to size of internal
file.
2004-06-09 Bud Davis <bdavis9659@comcast.net>
PR gfortran/15755

View File

@ -608,14 +608,18 @@ formatted_transfer (bt type, void *p, int len)
break;
case FMT_T:
pos = f->u.n ;
pos= current_unit->recl - current_unit->bytes_left - pos;
/* fall through */
case FMT_TL:
consume_data_flag = 0 ;
pos = f->u.n ;
case FMT_T:
if (f->format==FMT_TL)
{
pos = f->u.n ;
pos= current_unit->recl - current_unit->bytes_left - pos;
}
else // FMT==T
{
consume_data_flag = 0 ;
pos = f->u.n - 1;
}
if (pos < 0 || pos >= current_unit->recl )
{
@ -898,8 +902,12 @@ data_transfer_init (int read_flag)
if (current_unit == NULL)
return;
if (is_internal_unit() && g.mode==WRITING)
empty_internal_buffer (current_unit->s);
if (is_internal_unit())
{
current_unit->recl = file_length(current_unit->s);
if (g.mode==WRITING)
empty_internal_buffer (current_unit->s);
}
/* Check the action */