mirror of
https://github.com/gcc-mirror/gcc.git
synced 2024-11-21 13:40:47 +00:00
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.
This commit is contained in:
Jerry DeLisle
parent
09992f8b88
commit
93adf88cc6
@ -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
|
||||
|
||||
114
gcc/testsuite/gfortran.dg/pr114304.f90
Normal file
114
gcc/testsuite/gfortran.dg/pr114304.f90
Normal file
@ -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
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user