From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Tue, 13 Feb 2024 22:32:21 +0000 (-0800)
Subject: Fortran: Implement read_x for UTF-8 encoded files.
X-Git-Tag: basepoints/gcc-15~1156
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=b79d3e6a9284703b70688122f7d4955e7c50804a;p=thirdparty%2Fgcc.git

Fortran: Implement read_x for UTF-8 encoded files.

	PR fortran/99210

libgfortran/ChangeLog:

	* io/read.c (read_x): If UTF-8 encoding is enabled, use
	read_utf8 to move one character over in the read buffer.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr99210.f90: New test.
---

diff --git a/gcc/testsuite/gfortran.dg/pr99210.f90 b/gcc/testsuite/gfortran.dg/pr99210.f90
new file mode 100644
index 000000000000..9fd2fb468df0
--- /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 0ffcf76fd387..e2d2f8be8065 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;