]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Implement read_x for UTF-8 encoded files.
authorJerry DeLisle <jvdelisle@gcc.gnu.org>
Tue, 13 Feb 2024 22:32:21 +0000 (14:32 -0800)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Wed, 14 Feb 2024 15:57:53 +0000 (07:57 -0800)
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.

gcc/testsuite/gfortran.dg/pr99210.f90 [new file with mode: 0644]
libgfortran/io/read.c

diff --git a/gcc/testsuite/gfortran.dg/pr99210.f90 b/gcc/testsuite/gfortran.dg/pr99210.f90
new file mode 100644 (file)
index 0000000..9fd2fb4
--- /dev/null
@@ -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
index 0ffcf76fd3872146658fa4bd6fec722ab4972f61..e2d2f8be8065665595558faa383981e875edc4a4 100644 (file)
@@ -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;