[gcc r15-7009] libfortran: G formatting for UNSIGNED [PR118536]

[Harald Anlauf via Gcc-cvs]

https://gcc.gnu.org/g:ca2681d45a45077010bcc5a4547450044bdd6d78

commit r15-7009-gca2681d45a45077010bcc5a4547450044bdd6d78
Author: Harald Anlauf <anl...@gmx.de>
Date:   Fri Jan 17 21:20:31 2025 +0100

    libfortran: G formatting for UNSIGNED [PR118536]
    
            PR libfortran/118536
    
    libgfortran/ChangeLog:
    
            * io/transfer.c (formatted_transfer_scalar_write): Handle UNSIGNED
            in G formatting.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/unsigned_write_2.f90: New test.

Diff:
---
 gcc/testsuite/gfortran.dg/unsigned_write_2.f90 | 30 ++++++++++++++++++++++++++
 libgfortran/io/transfer.c                      |  3 +++
 2 files changed, 33 insertions(+)

diff --git a/gcc/testsuite/gfortran.dg/unsigned_write_2.f90 
b/gcc/testsuite/gfortran.dg/unsigned_write_2.f90
new file mode 100644
index 000000000000..091e9b99f107
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_write_2.f90
@@ -0,0 +1,30 @@
+! { dg-do  run }
+! This is a libgfortran (runtime library) test, need to run only once!
+!
+! { dg-additional-options "-funsigned" }
+!
+! PR libfortran/118536 - G formatting for UNSIGNED
+
+program print_unsigned_g_formatted
+  character(21) :: s1, s2
+  unsigned(1)  :: u1 = huge(0U_1)
+  unsigned(2)  :: u2 = huge(0U_2)
+  unsigned(4)  :: u4 = huge(0U_4)
+  unsigned(8)  :: u8 = huge(0U_8)
+
+  write(s1,'(i0)') u1
+  write(s2,'(g0)') u1
+  if (s1 /= s2) stop 1
+
+  write(s1,'(i0)') u2
+  write(s2,'(g0)') u2
+  if (s1 /= s2) stop 2
+
+  write(s1,'(i0)') u4
+  write(s2,'(g0)') u4
+  if (s1 /= s2) stop 3
+
+  write(s1,'(i0)') u8
+  write(s2,'(g0)') u8
+  if (s1 /= s2) stop 4
+end
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 0177e0520628..b3b72f39c5b1 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2365,6 +2365,9 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt 
type, void *p, int kin
              case BT_INTEGER:
                write_i (dtp, f, p, kind);
                break;
+             case BT_UNSIGNED:
+               write_iu (dtp, f, p, kind);
+               break;
              case BT_LOGICAL:
                write_l (dtp, f, p, kind);
                break;