From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1442) id E21183858D38; Mon, 22 Apr 2024 04:23:13 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E21183858D38 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1713759793; bh=4M0ADA45mD3KADPl0hMABC1/I08bxqlAZz4W8MbNSfk=; h=From:To:Subject:Date:From; b=DBmHmM04jhF2XikQjjb9yJXC1l9XVSCAaWPm1lWr5oKCW2dk438SukxjZxdSN9R2S 8Lgs19molEZf445h3rsyi9zgiW33Wd44hpDui9S5qFPd0uHlvaduVeiV4s7E2DWp+b P6qKbVqcyCi2VSjHoOBj3bl+9VYypTJpPpvKSUgw= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Jerry DeLisle To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-8640] libfortran: Fix handling of formatted separators. X-Act-Checkin: gcc X-Git-Author: Jerry DeLisle X-Git-Refname: refs/heads/releases/gcc-13 X-Git-Oldrev: ad80dc69b61c756f0a8fe36f42713dd8f3115b65 X-Git-Newrev: b55a35bcc80a7402576556c2f9d161229fb220ef Message-Id: <20240422042313.E21183858D38@sourceware.org> Date: Mon, 22 Apr 2024 04:23:13 +0000 (GMT) List-Id: https://gcc.gnu.org/g:b55a35bcc80a7402576556c2f9d161229fb220ef commit r13-8640-gb55a35bcc80a7402576556c2f9d161229fb220ef Author: Jerry DeLisle 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 '' as variant to ' ' as separator +! Check that and 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 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;