From 93adf88cc6744aa2c732b765e1e3b96e66cb3300 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 5 Apr 2024 19:25:13 -0700 Subject: [PATCH] libfortran: Fix handling of formatted separators. 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 ';'. (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 to verify new error message. * gfortran.dg/pr114304.f90: New test. --- gcc/testsuite/gfortran.dg/pr105473.f90 | 4 +- gcc/testsuite/gfortran.dg/pr114304.f90 | 114 +++++++++++++++++++++++++ libgfortran/io/list_read.c | 41 +++++++-- 3 files changed, 152 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr114304.f90 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.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 fb3f7dbc34d..b56f2a4e6d6 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -461,11 +461,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 == ' ') + { + 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 ',': @@ -476,8 +495,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; @@ -2144,7 +2173,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;