Dear all,
the attached obvious patch extends G formatting to UNSIGNED by reusing
the code for I formatting.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 5ba7e37a089257dc40e9f347a835a481121a3f3f Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Fri, 17 Jan 2025 21:20:31 +0100
Subject: [PATCH] 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.
---
.../gfortran.dg/unsigned_write_2.f90 | 30 +++++++++++++++++++
libgfortran/io/transfer.c | 3 ++
2 files changed, 33 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/unsigned_write_2.f90
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 00000000000..091e9b99f10
--- /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 0177e052062..b3b72f39c5b 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;
--
2.43.0
