From a71d87431d0c4e04a402ef6566be090c470b2b53 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Sat, 17 Feb 2024 09:24:58 -0800
Subject: 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.
---
 libgfortran/io/list_read.c | 48 ++++++++++++++++++++++++++++++++++++++--------
 libgfortran/io/read.c      | 11 ++++++++++-
 2 files changed, 50 insertions(+), 9 deletions(-)

(limited to 'libgfortran')

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 0b7884f..3d29cb6 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;
@@ -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;
 
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index e2d2f8b..7a9e341 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)
-- 
cgit v1.1