diff --git a/gcc/testsuite/gfortran.dg/pr105473.f90 b/gcc/testsuite/gfortran.dg/pr105473.f90 new file mode 100644 index 00000000000..b309217540d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr105473.f90 @@ -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 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0b7884fdda7..d2316ad6fe2 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -53,7 +53,6 @@ typedef unsigned char uchar; #define CASE_SEPARATORS /* Fall through. */ \ case ' ': case ',': case '/': case '\n': \ case '\t': case '\r': case ';' - /* This macro assumes that we're operating on a variable. */ #define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \ @@ -475,11 +474,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 +1337,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 +1652,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 +1703,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 +1749,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; diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index e2d2f8be806..7a9e341d7d8 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -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)