diff mbox series

[libgfortran] Bug 105473 - semicolon allowed when list-directed read integer with decimal='point'

Message ID 10cb5f16-9cba-4f3f-875c-3e55d0c89525@gmail.com
State New
Headers
Series [libgfortran] Bug 105473 - semicolon allowed when list-directed read integer with decimal='point' |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-arm success Testing passed
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 success Testing passed
linaro-tcwg-bot/tcwg_gcc_check--master-arm success Testing passed
linaro-tcwg-bot/tcwg_gcc_check--master-aarch64 success Testing passed

Commit Message

Jerry D Feb. 17, 2024, 4:02 a.m. UTC 
  Hello,

I posted the attached patch in bugzilla some time ago. This includes a 
new test case. The patch adds additional checks in key places to catch 
eroneous use of semicolons

Regression tested on x86_64,

OK for trunk and later backport to 13?

Jerry

Comments

FX Coudert Feb. 17, 2024, 10:24 a.m. UTC | #1 
> OK for trunk and later backport to 13?

OK. Thanks for the patch!

FX
diff mbox series

Patch

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)