This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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)



Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]