This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] patch for pr 16805--error on list directed internal read
- From: Bud Davis <bdavis9659 at comcast dot net>
- To: "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Sun, 29 Aug 2004 11:09:05 -0500
- Subject: [gfortran] patch for pr 16805--error on list directed internal read
list directed I/I wants a '/n' or eoln set true, and these were never
being set for internal I/O.
no additional failures on i686/gnu/linux FC1.
2004-08-29 Bud Davis <bdavis9659@comcast.net>
PR fortran/pr16805
* io/list_read.c (next_char): handle end for internal reads.
this test fails before and passes after applying the below patch:
! pr16805
! libgfortran bug
! list directed reads from character substrings
implicit none
character*10 a
data a /'1234567890'/
integer i
logical debug
data debug /.TRUE./
read(a,*)i
if (i.ne.1234567890) then
if (debug) print*,i
call abort
endif
read(a(1:1),*)i
if (i.ne.1) then
if (debug) print*,i
call abort
endif
read(a(2:2),*)i
if (i.ne.2) then
if (debug) print*,i
call abort
endif
read(a(1:5),*)i
if (i.ne.12345) then
if (debug) print*,i
call abort
endif
read(a(5:10),*)i
if (i.ne.567890) then
if (debug) print*,i
call abort
endif
read(a(10:10),*)i
if (i.ne.0) then
if (debug) print*,i
call abort
endif
end
--bud
Index: gcc/libgfortran/io/list_read.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/list_read.c,v
retrieving revision 1.6
diff -c -3 -p -r1.6 list_read.c
*** gcc/libgfortran/io/list_read.c 23 Aug 2004 14:28:31 -0000 1.6
--- gcc/libgfortran/io/list_read.c 29 Aug 2004 16:01:35 -0000
*************** next_char (void)
*** 137,144 ****
p = salloc_r (current_unit->s, &length);
if (p == NULL)
{
! generate_error (ERROR_OS, NULL);
! return '\0';
}
if (length == 0)
--- 137,152 ----
p = salloc_r (current_unit->s, &length);
if (p == NULL)
{
! if (is_internal_unit ())
! {
! c = '\n';
! goto done;
! }
! else
! {
! generate_error (ERROR_OS, NULL);
! return '\0';
! }
}
if (length == 0)