https://gcc.gnu.org/g:7ecea49245bc6aeb6c889a4914961f94417f16e5

commit r13-8411-g7ecea49245bc6aeb6c889a4914961f94417f16e5
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date:   Sat Feb 17 09:24:58 2024 -0800

    libgfortran: [PR105473] Fix checks for decimal='comma'.
    
            PR libfortran/105473
    
    libgfortran/ChangeLog:
    
            * io/list_read.c (eat_separator): Reject comma as a
            separator when it is being used as a decimal point.
            (parse_real): Reject a '.' when it 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.
    
    (cherry picked from commit a71d87431d0c4e04a402ef6566be090c470b2b53)

Diff:
---
 gcc/testsuite/gfortran.dg/pr105473.f90 | 46 ++++++++++++++++++++++++++++++++
 libgfortran/io/list_read.c             | 48 ++++++++++++++++++++++++++++------
 libgfortran/io/read.c                  | 11 +++++++-
 3 files changed, 96 insertions(+), 9 deletions(-)

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 109313c15b1..6ae8de548bb 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -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;
@@ -1318,8 +1330,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:
@@ -1628,8 +1645,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:
@@ -1669,8 +1696,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:
@@ -1710,7 +1742,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 9505acd2c43..bf2500fc5d0 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)

Reply via email to