[gfortran] Fix list directed reads of real number

[Steve Kargl]

On Wed, Dec 08, 2004 at 10:25:36PM -0800, Steve Kargl wrote:
> The attached patch fixes a bug in the list directed read of
> several values from a single line.  This patch has been
> bootstrapped and regression tested on i386-*-FreeBSD6.0.
> It actually fixes 4 failures in the testsuite.
> 

Okay, I have a slightly improved patch and a better testcase.
Can someone PLEASE commit this patch?  This patch fixes a boat 
load of failures in the LAPACK testsuite.  I have bootstrapped
 and regressions tested this patch on
i386-*-freebsd.

Without the patch the LAPACK tests produce

./testing/dgd.out: DXV drivers:    200 out of   5000 tests failed to pass the threshold
./testing/zgd.out: ZXV drivers:     24 out of   5000 tests failed to pass the threshold
./testing/ssep.out: SST:    1 out of  4662 tests failed to pass the threshold
./testing/ssep.out: SST drivers:      1 out of  14256 tests failed to pass the threshold
./testing/sgd.out: SXV drivers:     37 out of   5000 tests failed to pass the threshold
./testing/csep.out: CST:    1 out of  4662 tests failed to pass the threshold
./testing/csep.out: CST:    2 out of  4662 tests failed to pass the threshold
./testing/csvd.out: CBD:      1 out of   4085 tests failed to pass the threshold
./testing/ztest.out: ZGT drivers:     36 out of   2033 tests failed to pass the threshold
./testing/ztest.out: ZHE:    124 out of   1624 tests failed to pass the threshold
./testing/ztest.out: ZHE drivers:     94 out of   1072 tests failed to pass the threshold
./testing/ztest.out: ZHP:    124 out of   1404 tests failed to pass the threshold
./testing/ztest.out: ZHP drivers:     94 out of   1072 tests failed to pass the threshold
./testing/ztest.out: ZSY:     68 out of   1864 tests failed to pass the threshold
./testing/ztest.out: ZSY drivers:     58 out of   1240 tests failed to pass the threshold
./testing/ztest.out: ZSP:     68 out of   1620 tests failed to pass the threshold
./testing/ztest.out: ZSP drivers:     58 out of   1240 tests failed to pass the threshold
./testing/ctest.out: CGT:    764 out of   2694 tests failed to pass the threshold
./testing/ctest.out: CGT drivers:    516 out of   2033 tests failed to pass the threshold
./testing/ctest.out: CHE:    128 out of   1624 tests failed to pass the threshold
./testing/ctest.out: CHE drivers:     94 out of   1072 tests failed to pass the threshold
./testing/ctest.out: CHP:    124 out of   1404 tests failed to pass the threshold
./testing/ctest.out: CHP drivers:     94 out of   1072 tests failed to pass the threshold
./testing/ctest.out: CSY:     92 out of   1864 tests failed to pass the threshold
./testing/ctest.out: CSY drivers:     72 out of   1240 tests failed to pass the threshold
./testing/ctest.out: CSP:     84 out of   1620 tests failed to pass the threshold
./testing/ctest.out: CSP drivers:     72 out of   1240 tests failed to pass the threshold
./testing/ctest.out: CLS drivers:   3096 out of  65268 tests failed to pass the threshold

With the patch the LAPACK tests produce

./testing/dgd.out: DXV drivers:    200 out of   5000 tests failed to pass the threshold
./testing/zgd.out: ZXV drivers:     24 out of   5000 tests failed to pass the threshold
./testing/ssep.out: SST:    1 out of  4662 tests failed to pass the threshold
./testing/ssep.out: SST drivers:      1 out of  14256 tests failed to pass the threshold
./testing/sgd.out: SXV drivers:     37 out of   5000 tests failed to pass the threshold
./testing/csep.out: CST:    1 out of  4662 tests failed to pass the threshold
./testing/csep.out: CST:    2 out of  4662 tests failed to pass the threshold

-- 
Steve
-------------- next part --------------
! { dg-do run }
! Program to test reading in a list of integer values into REAL variables.
! The comma separator was not handled correctly.
!
program fg

  character(len=80) buff

  write (buff,'(a)') '10,20,30,40'
  read(buff,*) a, b, c, d

  if (abs(10. - a) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort

  call abc

end program

subroutine abc

  character(len=80) buff

  write (buff,'(a)') '10,-20,30,-40'
  read(buff,*) a, b, c, d

  if (abs(10. - a) > 1e-5) call abort
  if (abs(-20. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(-40. - d) > 1e-5) call abort

end subroutine abc
-------------- next part --------------
--- list_read.c	Sat Dec 11 19:47:17 2004
+++ list_read.c.orig	Sat Dec 11 19:26:23 2004
@@ -998,9 +998,9 @@
       goto got_sign;
 
     CASE_SEPARATORS:
-      unget_char (c);		/* Single null.  */
+      unget_char (c);
       eat_separator ();
-      return;
+      break;
 
     default:
       goto bad_real;
@@ -1043,8 +1043,11 @@
 	  goto got_repeat;
 
 	CASE_SEPARATORS:
+#if 0
+/* If we remove the #if 0, we fix PR 17597.  However, we break F95 parse.  */
           if (c != '\n')
             unget_char (c);    /* Real number that is just a digit-string.  */
+#endif
 	  goto done;
 
 	default: