[gcc r13-8640] libfortran: Fix handling of formatted separators.

[gcc r13-8640] libfortran: Fix handling of formatted separators.

[Jerry DeLisle]

https://gcc.gnu.org/g:b55a35bcc80a7402576556c2f9d161229fb220ef

commit r13-8640-gb55a35bcc80a7402576556c2f9d161229fb220ef
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date:   Sun Apr 21 20:50:26 2024 -0700

    libfortran: Fix handling of formatted separators.
    
            Backport from mainline.
    
            PR libfortran/114304
            PR libfortran/105473
    
    libgfortran/ChangeLog:
    
            * io/list_read.c (eat_separator): Add logic to handle spaces
            preceding a comma or semicolon such that that a 'null' read
            occurs without error at the end of comma or semicolon
            terminated input lines. Add check and error message for ';'.
            Accept tab as alternative to space.
            (list_formatted_read_scalar): Treat comma as a decimal point
            when specified by the decimal mode on the first item.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pr105473.f90: Modify for revised checks.
            * gfortran.dg/pr114304-2.f90: New test.
            * gfortran.dg/pr114304.f90: New test.

Diff:
---
 gcc/testsuite/gfortran.dg/pr105473.f90   |   4 +-
 gcc/testsuite/gfortran.dg/pr114304-2.f90 |  82 ++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr114304.f90   | 114 +++++++++++++++++++++++++++++++
 libgfortran/io/list_read.c               |  41 +++++++++--
 4 files changed, 234 insertions(+), 7 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/pr105473.f90 b/gcc/testsuite/gfortran.dg/pr105473.f90
index 2679f6bb447..863a312c794 100644
--- a/gcc/testsuite/gfortran.dg/pr105473.f90
+++ b/gcc/testsuite/gfortran.dg/pr105473.f90
@@ -9,11 +9,11 @@
   n = 999; m = 777; r=1.2345
   z = cmplx(0.0,0.0)
 
-! Check that semi-colon is allowed as separator with decimal=point.
+! Check that semi-colon is not allowed as separator with decimal=point.
   ios=0
   testinput = '1;17;3.14159'
   read(testinput,*,decimal='point',iostat=ios) n, m, r
-  if (ios /= 0) stop 1
+  if (ios /= 5010) stop 1
 
 ! Check that semi-colon allowed as a separator with decimal=point.
   ios=0
diff --git a/gcc/testsuite/gfortran.dg/pr114304-2.f90 b/gcc/testsuite/gfortran.dg/pr114304-2.f90
new file mode 100644
index 00000000000..5ef5874f528
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114304-2.f90
@@ -0,0 +1,82 @@
+! { dg-do run }
+!
+! PR fortran/114304
+!
+! Ensure that '\t' (tab) is supported as separator in list-directed input
+! While not really standard conform, this is widely used in user input and
+! widely supported.
+!
+
+use iso_c_binding
+implicit none
+character(len=*,kind=c_char), parameter :: tab = C_HORIZONTAL_TAB
+
+! Accept '<tab>' as variant to ' ' as separator
+! Check that <carriage_return><new line> and <new_line> are handled
+
+character(len=*,kind=c_char), parameter :: nml_str &
+   = '&inparm'//C_CARRIAGE_RETURN // C_NEW_LINE // &
+     'first'//tab//'='//tab//' .true.'// C_NEW_LINE // &
+     ' , other'//tab//' ='//tab//'3'//tab//', 2'//tab//'/'
+
+! Check that <carriage_return> is handled,
+
+! Note: For new line, Unix uses \n, Windows \r\n but old Apple systems used '\r'
+!
+! Gfortran does not seem to support all \r, but the following is supported
+! since ages, ! which seems to be a gfortran extension as ifort and flang don't like it.
+
+character(len=*,kind=c_char), parameter :: nml_str2 &
+   = '&inparm'//C_CARRIAGE_RETURN // C_NEW_LINE // &
+     'first'//C_NEW_LINE//'='//tab//' .true.'// C_CARRIAGE_RETURN // &
+     ' , other'//tab//' ='//tab//'3'//tab//', 2'//tab//'/'
+
+character(len=*,kind=c_char), parameter :: str &
+   = tab//'1'//tab//'2,'//tab//'3'//tab//',4'//tab//','//tab//'5'//tab//'/'
+character(len=*,kind=c_char), parameter :: str2 &
+   = tab//'1'//tab//'2;'//tab//'3'//tab//';4'//tab//';'//tab//'5'//tab//'/'
+logical :: first
+integer :: other(4)
+integer :: ints(6)
+namelist /inparm/ first , other
+
+other = 1
+
+open(99, file="test.inp")
+write(99, '(a)') nml_str
+rewind(99)
+read(99,nml=inparm)
+close(99, status="delete")
+
+if (.not.first .or. any (other /= [3,2,1,1])) stop 1
+
+other = 9
+
+open(99, file="test.inp")
+write(99, '(a)') nml_str2
+rewind(99)
+read(99,nml=inparm)
+close(99, status="delete")
+
+if (.not.first .or. any (other /= [3,2,9,9])) stop 2
+
+ints = 66
+
+open(99, file="test.inp", decimal='point')
+write(99, '(a)') str
+rewind(99)
+read(99,*) ints
+close(99, status="delete")
+
+if (any (ints /= [1,2,3,4,5,66])) stop 3
+
+ints = 77 
+
+open(99, file="test.inp", decimal='comma')
+write(99, '(a)') str2
+rewind(99)
+read(99,*) ints
+close(99, status="delete")
+
+if (any (ints /= [1,2,3,4,5,77])) stop 4
+end
diff --git a/gcc/testsuite/gfortran.dg/pr114304.f90 b/gcc/testsuite/gfortran.dg/pr114304.f90
new file mode 100644
index 00000000000..2f913f1ab34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114304.f90
@@ -0,0 +1,114 @@
+! { dg-do run }
+!
+! PR fortran/114304
+!
+! See also PR fortran/105473
+!
+! Testing: Does list-directed reading an integer/real allow some non-integer input?
+!
+! Note: GCC result comments before fix of this PR.
+
+  implicit none
+  call t(.true.,  'comma', ';') ! No error shown
+  call t(.false., 'point', ';') ! /!\ gfortran: no error, others: error
+  call t(.false., 'comma', ',') ! Error shown
+  call t(.true.,  'point', ',') ! No error shown
+  call t(.false., 'comma', '.') ! Error shown
+  call t(.false., 'point', '.') ! Error shown
+  call t(.false., 'comma', '5.') ! Error shown
+  call t(.false., 'point', '5.') ! gfortran/flang: Error shown, ifort: no error
+  call t(.false., 'comma', '5,') ! gfortran: error; others: no error
+  call t(.true.,  'point', '5,') ! No error shown
+  call t(.true.,  'comma', '5;') ! No error shown
+  call t(.false., 'point', '5;') ! /!\ gfortran: no error shown, others: error
+  call t(.true.,  'comma', '7 .') ! No error shown
+  call t(.true.,  'point', '7 .') ! No error shown
+  call t(.true.,  'comma', '7 ,') ! /!\ gfortran: error; others: no error
+  call t(.true.,  'point', '7 ,') ! No error shown
+  call t(.true.,  'comma', '7 ;') ! No error shown
+  call t(.true.,  'point', '7 ;') ! No error shown
+
+!  print *, '---------------'
+
+  call t(.false., 'comma', '8.', .true.) ! Error shown
+  call t(.true.,  'point', '8.', .true.) ! gfortran/flang: Error shown, ifort: no error
+  call t(.true.,  'comma', '8,', .true.) ! gfortran: error; others: no error
+  call t(.true.,  'point', '8,', .true.) ! No error shown
+  call t(.true.,  'comma', '8;', .true.) ! No error shown
+  call t(.false., 'point', '8;', .true.) ! /!\ gfortran: no error shown, others: error
+  call t(.true.,  'comma', '9 .', .true.) ! No error shown
+  call t(.true.,  'point', '9 .', .true.) ! No error shown
+  call t(.true.,  'comma', '9 ,', .true.) ! /!\ gfortran: error; others: no error
+  call t(.true.,  'point', '9 ,', .true.) ! No error shown
+  call t(.true.,  'comma', '9 ;', .true.) ! No error shown
+  call t(.true.,  'point', '9 ;', .true.) ! No error shown
+  call t(.false., 'comma', '3,3.', .true.) ! Error shown
+  call t(.false., 'point', '3.3.', .true.) ! Error shown
+  call t(.false., 'comma', '3,3,', .true.) ! gfortran/flang: no error; ifort: error
+  call t(.true.,  'comma', '3,3;', .true.) ! No error shown
+  call t(.false., 'point', '3.3;', .true.) ! gfortran/flang: no error; ifort: error
+  call t(.true.,  'comma', '4,4 .', .true.) ! N error shown
+  call t(.true.,  'point', '4.4 .', .true.) ! No error shown
+  call t(.true.,  'comma', '4,4 ,', .true.) ! /!\ gfortran: error; others: no error
+  call t(.true.,  'point', '4.4 ,', .true.) ! No error shown
+  call t(.true.,  'comma', '4,4 ;', .true.) ! No error shown
+  call t(.true.,  'point', '4.4 ;', .true.) ! No error shown
+
+!  print *, '---------------'
+
+  call t(.true.,  'comma', '8', .true.)
+  call t(.true.,  'point', '8', .true.)
+  call t(.true.,  'point', '9 ;', .true.)
+  call t(.true.,  'comma', '3;3.', .true.)
+  call t(.true.,  'point', '3,3.', .true.)
+  call t(.true.,  'comma', '3;3,', .true.)
+  call t(.true.,  'comma', '3;3;', .true.)
+  call t(.true.,  'point', '3,3;', .true.)
+  call t(.true.,  'comma', '4;4 .', .true.)
+  call t(.true.,  'point', '4,4 .', .true.)
+  call t(.true.,  'comma', '4;4 ,', .true.)
+  call t(.true.,  'point', '4,4 ,', .true.)
+  call t(.true.,  'comma', '4;4 ;', .true.)
+  call t(.true.,  'point', '4,4 ;', .true.)
+
+  call t2('comma', ',2')
+  call t2('point', '.2')
+  call t2('comma', ',2;')
+  call t2('point', '.2,')
+  call t2('comma', ',2 ,')
+  call t2('point', '.2 .')
+contains
+subroutine t2(dec, testinput)
+  character(*) :: dec, testinput
+  integer ios
+  real :: r
+  r = 42
+  read(testinput,*,decimal=dec, iostat=ios) r
+  if (ios /= 0 .or.  abs(r - 0.2) > epsilon(r)) then
+    stop 3 
+  end if
+end
+subroutine t(valid, dec, testinput, isreal)
+  logical, value :: valid
+  character(len=*) :: dec, testinput
+  logical, optional :: isreal
+  logical :: isreal2
+  integer n,ios
+  real :: r
+  r = 42; n = 42
+  isreal2 = .false.
+  if (present(isreal)) isreal2 = isreal
+
+  if (isreal2) then
+    read(testinput,*,decimal=dec,iostat=ios) r
+    if ((valid .and. ios /= 0) .or. (.not.valid .and. ios == 0)) then
+      stop 1
+    end if
+  else
+    read(testinput,*,decimal=dec,iostat=ios) n
+    if ((valid .and. ios /= 0) .or. (.not.valid .and. ios == 0)) then
+      stop 1
+    end if
+  end if
+end
+end program
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index eabc67c16af..635ba486fee 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -465,11 +465,30 @@ eat_separator (st_parameter_dt *dtp)
   int c, n;
   int err = 0;
 
-  eat_spaces (dtp);
   dtp->u.p.comma_flag = 0;
+  c = next_char (dtp);
+  if (c == ' '  || c == '\t')
+    {
+      eat_spaces (dtp);
+      c = next_char (dtp);
+      if (c == ',')
+	{
+	  if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
+	    unget_char (dtp, ';');
+	  dtp->u.p.comma_flag = 1;
+	  eat_spaces (dtp);
+	  return err;
+	}
+      if (c == ';')
+	{
+	  if (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT)
+	    unget_char (dtp, ',');
+	  dtp->u.p.comma_flag = 1;
+	  eat_spaces (dtp);
+	  return err;
+	}
+    }
 
-  if ((c = next_char (dtp)) == EOF)
-    return LIBERROR_END;
   switch (c)
     {
     case ',':
@@ -480,8 +499,18 @@ eat_separator (st_parameter_dt *dtp)
 	  unget_char (dtp, c);
 	  break;
 	}
-    /* Fall through. */
+      dtp->u.p.comma_flag = 1;
+      eat_spaces (dtp);
+      break;
+
     case ';':
+      if (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT)
+	{
+	  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+	   "Semicolon not allowed as separator with DECIMAL='point'");
+	  unget_char (dtp, c);
+	  break;
+	}
       dtp->u.p.comma_flag = 1;
       eat_spaces (dtp);
       break;
@@ -2140,7 +2169,9 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
 	  err = LIBERROR_END;
 	  goto cleanup;
 	}
-      if (is_separator (c))
+      if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
+	c = '.';
+      else if (is_separator (c))
 	{
 	  /* Found a null value.  */
 	  dtp->u.p.repeat_count = 0;