OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

backport: re PR fortran/80741 ([Regression 7/8] DTIO wrong code causes incorrect behaviour of namelist READ)

Browse Source 
2017-05-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	Backport from trunk
	PR libgfortran/80741
	* transfer.c (finalize_transfer): Reset last_char to 'empty'.
	* file_pos.c (formatted_backspace): Likewise.
	(st_endfile): Likewise.
	(st_rewind): Likewise.
	(st_flush): Likewise.

	* trans-io.c (transfer_namelist_element): Change check from
	NULL_TREE to null_pointer_node.

	* gfortran.dg/read_4.f90: New test.

From-SVN: r248390
This commit is contained in:
Jerry DeLisle 2017-05-23 22:05:56 +00:00
parent 70e971cc61
commit 90d2abbe74
7 changed files with 65 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2017-05-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk
PR fortran/80741
* trans-io.c (transfer_namelist_element): Change check from
NULL_TREE to null_pointer_node.
2017-05-23 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk

2
gcc/fortran/trans-io.c
View File

@ -1767,7 +1767,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
else
tmp = build_int_cst (gfc_charlen_type_node, 0);
if (dtio_proc == NULL_TREE)
if (dtio_proc == null_pointer_node)
tmp = build_call_expr_loc (input_location,
iocall[IOCALL_SET_NML_VAL], 6,
dt_parm_addr, addr_expr, string,

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2017-05-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk
PR libgfortran/80741
* gfortran.dg/read_4.f90: New test.
2017-05-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk

35
gcc/testsuite/gfortran.dg/read_4.f90 Normal file
View File

@ -0,0 +1,35 @@
! { dg-do run }
! PR80741 wrong code causes incorrect behaviour of namelist READ
program p
use, intrinsic :: iso_fortran_env, only: iostat_end
implicit none
integer :: x, y, ios, io
character(10) :: line
namelist /test/ x, y
x = 10
y = 10
ios = 0
io = 10
open(unit=io, status='scratch')
write(io, test)
write(io, *) 'done'
rewind(io)
x = 0
y = 0
read(io, test)
if (x.ne.10 .or. y.ne.10) call abort
!
read(io, *) line
if (line.ne.'done') call abort
!
read(io, *, iostat=ios) line
if (ios/=iostat_end) call abort
rewind(io)
x = 0
y = 0
read(io, test)
if (x.ne.10 .or. y.ne.10) call abort
read(io, *, iostat=ios) line
if (line.ne.'done') call abort
end

10
libgfortran/ChangeLog
View File

@ -1,3 +1,13 @@
2017-05-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk
PR libgfortran/80741
* transfer.c (finalize_transfer): Reset last_char to 'empty'.
* file_pos.c (formatted_backspace): Likewise.
(st_endfile): Likewise.
(st_rewind): Likewise.
(st_flush): Likewise.
2017-05-23 Paul Thomas <pault@gcc.gnu.org>
Jerry DeLisle <jvdelisle@gcc.gnu.org>

6
libgfortran/io/file_pos.c
View File

@ -82,7 +82,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
goto io_error;
u->last_record--;
u->endfile = NO_ENDFILE;
u->last_char = EOF - 1;
return;
io_error:
@ -322,6 +322,7 @@ st_endfile (st_parameter_filepos *fpp)
unit_truncate (u, stell (u->s), &fpp->common);
u->endfile = AFTER_ENDFILE;
u->last_char = EOF - 1;
if (0 == stell (u->s))
u->flags.position = POSITION_REWIND;
}
@ -371,6 +372,7 @@ st_endfile (st_parameter_filepos *fpp)
if (u == NULL)
return;
u->endfile = AFTER_ENDFILE;
u->last_char = EOF - 1;
}
}
@ -430,6 +432,7 @@ st_rewind (st_parameter_filepos *fpp)
u->current_record = 0;
u->strm_pos = 1;
u->read_bad = 0;
u->last_char = EOF - 1;
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
@ -458,6 +461,7 @@ st_flush (st_parameter_filepos *fpp)
fbuf_flush (u, u->mode);
sflush (u->s);
u->last_char = EOF - 1;
unlock_unit (u);
}
else

2
libgfortran/io/transfer.c
View File

@ -3977,7 +3977,7 @@ finalize_transfer (st_parameter_dt *dtp)
fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
dtp->u.p.current_unit->saved_pos = 0;
dtp->u.p.current_unit->last_char = EOF - 1;
next_record (dtp, 1);
done: