[gfortran] patch for pr14942 -- list directed I/O

[Bud Davis]

This patch corrects the specific examples listed in the PR. It 
does not break anything else I am aware of, but I doubt if list
directed I/O works 100%, it just works better :)

 



Change Log

2004-04-15  Bud Davis <bdavis9659@comcast.net>

	PR fortran/14942
	* io/list_read.c (read_real,read_complex,read_integer
	read_logical): continue reading when encountering a
        separator.
	* io/list_read.c (list_formatted_read): continue after
        a separator.


Here is the test suite file, which is the example from the PR, 
changed to create it's own data file and call abort if the reads 
are incorrect.

 
! pr 14942, list directed io
      program d
      implicit none
      integer i, j, m, n, nin, k
      real x(3,4)
      data x / 1,1,1,2,2,2,3,3,3,4,4,4 /
      real y(3,4)
      data y / 1,1,1,2,2,2,3,3,3,4,4,4 /
      logical debug ! set me true to see the output
      debug = .FALSE.
      nin = 1
      n = 4
      open(unit = nin)
      write(nin,*) n
      do I = 1,3
        write(nin,*)(x(i,j), j=1, n)
      end do
      m = 3
      n = 4
      write(nin,*) m,n
      do I = 1,3
         write(nin,*)(x(i,j), j=1, n)
      enddo
      close(nin)
! ok, the data file is written
      open(unit = nin)
      read(nin, fmt = *) n
      if (debug ) write(*,'(A,I2)') 'n = ', n
      do i = 1, 3
         do K = 1,n
             x(i,k) = -1
         enddo
         read(nin, fmt = *) (x(i,j), j=1, n)
         if (debug) write(*, *) (x(i,j), j=1, n)
          do K = 1,n
              if (x(i,k).ne.y(i,k)) call abort
          end do
      end do
      m = 0
      n = 0
      read(nin, fmt = *) m, n
      if (debug) write(*,'(A,I2,2X,A,I2)') 'm = ', m, 'n = ', n
      do i = 1, m
         do K = 1,n
             x(i,k) = -1
         enddo
         read(nin, fmt = *) (x(i,j), j=1, n)
         if (debug) write(*, *) (x(i,j), j=1, n)
         do K = 1,n
              if (x(i,k).ne.y(i,k)) call abort
         end do
      end do
      end program d


No additional failures on the gfortran test suite or on the NIST tests.



--bud




Index: gcc/libgfortran/io/list_read.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/list_read.c,v
retrieving revision 1.1.2.7
diff -c -3 -p -r1.1.2.7 list_read.c
*** gcc/libgfortran/io/list_read.c      24 Mar 2004 12:14:03 -0000      1.1.2.7
--- gcc/libgfortran/io/list_read.c      16 Apr 2004 01:59:03 -0000
*************** read_logical (int length)
*** 485,491 ****
      CASE_SEPARATORS:
        unget_char (c);
        eat_separator ();
!       return;                 /* Null value */
   
      default:
        goto bad_logical;
--- 485,491 ----
      CASE_SEPARATORS:
        unget_char (c);
        eat_separator ();
!       break;
   
      default:
        goto bad_logical;
*************** read_integer (int length)
*** 544,550 ****
      CASE_SEPARATORS:          /* Single null */
        unget_char (c);
        eat_separator ();
!       return;
   
      CASE_DIGITS:
        push_char (c);
--- 544,550 ----
      CASE_SEPARATORS:          /* Single null */
        unget_char (c);
        eat_separator ();
!       break;
   
      CASE_DIGITS:
        push_char (c);
*************** read_complex (int length)
*** 927,933 ****
      CASE_SEPARATORS:
        unget_char (c);
        eat_separator ();
!       return;
   
      default:
        goto bad_complex;
--- 927,933 ----
      CASE_SEPARATORS:
        unget_char (c);
        eat_separator ();
!       break;
   
      default:
        goto bad_complex;
*************** read_real (int length)
*** 997,1003 ****
      CASE_SEPARATORS:
        unget_char (c);         /* Single null */
        eat_separator ();
!       return;
   
      default:
        goto bad_real;
--- 997,1003 ----
      CASE_SEPARATORS:
        unget_char (c);         /* Single null */
        eat_separator ();
!       break;
   
      default:
        goto bad_real;
*************** list_formatted_read (bt type, void *p, i
*** 1243,1249 ****
        {                       /* Found a null value */
          eat_separator ();
          repeat_count = 0;
-         return;
        }
   
      }
--- 1243,1248 ----