libgfortran: [PR105473] Fix checks for decimal='comma'.

PR libfortran/105473

libgfortran/ChangeLog:

	* io/list_read.c (eat_separator): Reject comma as a
	seprator when it is being used as a decimal point.
	(parse_real): Reject a '.' when is should be a comma.
	(read_real): Likewise.
	* io/read.c (read_f): Add more checks for ',' and '.'
	conditions.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr105473.f90: New test.
This commit is contained in:
Jerry DeLisle 2024-02-17 09:24:58 -08:00
parent 296284a9db
commit a71d87431d
3 changed files with 96 additions and 9 deletions

View File

@ -0,0 +1,46 @@
! { dg-do run }
! PR libgfortran/105473
implicit none
integer n,m,ios
real r
complex z
character(40):: testinput
n = 999; m = 777; r=1.2345
z = cmplx(0.0,0.0)
! 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 /= 5010) print *, "stop 1"
! Check that comma is not allowed as a separator with decimal=comma.
ios=0
testinput = '1,17,3,14159'
read(testinput,*,decimal='comma',iostat=ios) n, m, r
if (ios /= 5010) print *, "stop 2"
! Check a good read.
ios=99
testinput = '1;17;3,14159'
read(testinput,*,decimal='comma',iostat=ios) n, m, r
if (ios /= 0) print *, "stop 3"
! Check that comma is not allowed as a separator with decimal=comma.
ios=99; z = cmplx(0.0,0.0)
testinput = '1,17, (3,14159, 1,7182)'
read(testinput,*,decimal='comma', iostat=ios) n, m, z
if (ios /= 5010) stop 4
! Check that semi-colon is not allowed as separator with decimal=point.
ios=99; z = cmplx(0.0,0.0)
testinput = '1,17; (3.14159; 1.7182)'
read(testinput,*,decimal='point', iostat=ios) n, m, z
if (ios /= 5010) stop 5
! Check a good read.
ios=99;z = cmplx(0.0,0.0)
testinput = '1;17; (3,14159; 1,7182)'
read(testinput,*,decimal='comma', iostat=ios) n, m, z
if (ios /= 0) stop 6
end program

View File

@ -475,11 +475,23 @@ eat_separator (st_parameter_dt *dtp)
case ',':
if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
{
generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Comma not allowed as separator with DECIMAL='comma'");
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;
@ -1326,8 +1338,13 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
{
if ((c = next_char (dtp)) == EOF)
goto bad;
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
c = '.';
if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
{
if (c == '.')
goto bad;
if (c == ',')
c = '.';
}
switch (c)
{
CASE_DIGITS:
@ -1636,8 +1653,18 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
seen_dp = 0;
c = next_char (dtp);
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
c = '.';
if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
{
if (c == '.')
goto bad_real;
if (c == ',')
c = '.';
}
if (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT)
{
if (c == ';')
goto bad_real;
}
switch (c)
{
CASE_DIGITS:
@ -1677,8 +1704,13 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
for (;;)
{
c = next_char (dtp);
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
c = '.';
if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
{
if (c == '.')
goto bad_real;
if (c == ',')
c = '.';
}
switch (c)
{
CASE_DIGITS:
@ -1718,7 +1750,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
CASE_SEPARATORS:
case EOF:
if (c != '\n' && c != ',' && c != '\r' && c != ';')
if (c != '\n' && c != ',' && c != ';' && c != '\r')
unget_char (dtp, c);
goto done;

View File

@ -1062,8 +1062,17 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
case ',':
if (dtp->u.p.current_unit->decimal_status != DECIMAL_COMMA)
goto bad_float;
/* Fall through. */
if (seen_dp)
goto bad_float;
if (!seen_int_digit)
*(out++) = '0';
*(out++) = '.';
seen_dp = 1;
break;
case '.':
if (dtp->u.p.current_unit->decimal_status != DECIMAL_POINT)
goto bad_float;
if (seen_dp)
goto bad_float;
if (!seen_int_digit)