[libgfortran] PR99210 X editing for reading file with encoding='utf-8'

Message ID f1a7994a-c0a8-459f-bddf-40783a52042c@protonmail.com
State Accepted
Headers
Series [libgfortran] PR99210 X editing for reading file with encoding='utf-8' |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Jerry DeLisle Feb. 13, 2024, 10:55 p.m. UTC
  The attached patch fixes the X editing.

Fairly self explanatory. I created the patch a few years back.

Regression tested on x86_64 and new test case.

OK for trunk?

Regards,

Jerry
  

Comments

FX Coudert Feb. 14, 2024, 1:11 p.m. UTC | #1
> Regression tested on x86_64 and new test case.
> OK for trunk?

OK, and thanks!

FX
  

Patch

diff --git a/gcc/testsuite/gfortran.dg/pr99210.f90 b/gcc/testsuite/gfortran.dg/pr99210.f90
new file mode 100644
index 00000000000..9fd2fb468df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99210.f90
@@ -0,0 +1,29 @@ 
+! { dg-do run }
+! PR99210 X editing for reading file with encoding='utf-8'
+program test_bug_format_x
+  use iso_fortran_env
+  integer, parameter :: u = selected_char_kind('ISO_10646')
+
+  character(kind=u, len=1) a, b, a1, b1, b2
+
+  open(unit=10, file='test_bug_format_x.tmp', encoding='UTF-8')
+
+  a = char(int(z'03B1'), u)
+  b = char(int(z'03B2'), u)
+  write(10, '(a1, a1)') a, b
+
+  rewind(10)
+  read(10, '(a1, a1)') a1, b1
+
+  rewind(10)
+  read(10, '(1x, a1)') b2
+
+  close (10, status="delete")
+  if(a /= a1 .or. b /= b1) then
+    error stop 1
+  end if
+
+  if(b /= b2) then
+    error stop 2
+  end if
+end program test_bug_format_x
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 0ffcf76fd38..e2d2f8be806 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -1307,6 +1307,23 @@  read_x (st_parameter_dt *dtp, size_t n)
     
   if (n == 0)
     return;
+    
+  if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
+    {
+      gfc_char4_t c;
+      size_t nbytes, j;
+    
+      /* Proceed with decoding one character at a time.  */
+      for (j = 0; j < n; j++)
+	{
+	  c = read_utf8 (dtp, &nbytes);
+    
+	  /* Check for a short read and if so, break out.  */
+	  if (nbytes == 0 || c == (gfc_char4_t)0)
+	    break;
+	}
+      return;
+    }
 
   length = n;