Hi all,
The attached implements the last piece of the puzzle for EX formatting. In this
case reading list directed input where hex format is found.
Regression tested on x86_64.
OK for mainline? Maybe backport?
Regards,
Jerry
---
fortran: Implement list directed read of hex float formats.
PR libfortran/93727
libgfortran/ChangeLog:
* io/list_read.c (parse_real): Parse the possible hexadecimal
float formatted and then allow the convert_real function to
validate the result.
gcc/testsuite/ChangeLog:
* gfortran.dg/EXformat_5.F90: New test.
---commit 850dd8c506e4847fbb510543fbcef03904f3a976
Author: Jerry DeLisle <[email protected]>
Date: Wed Jul 15 20:29:38 2026 -0700
fortran: Implement list directed read of hex float formats.
PR libfortran/93727
libgfortran/ChangeLog:
* io/list_read.c (parse_real): Parse the possible hexadecimal
float formatted and then allow the convert_real function to
validate the result.
gcc/testsuite/ChangeLog:
* gfortran.dg/EXformat_5.F90: New test.
diff --git a/gcc/testsuite/gfortran.dg/EXformat_5.F90 b/gcc/testsuite/gfortran.dg/EXformat_5.F90
new file mode 100644
index 00000000000..cfd699dd641
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/EXformat_5.F90
@@ -0,0 +1,131 @@
+! { dg-do run }
+! PR93727 Test hex float for list-directed READ.
+
+program main
+ implicit none
+ call test04
+ call test08
+ call test10
+ call test16
+
+contains
+
+subroutine test04
+ real(4) :: r4, a, b
+ real(4) :: arr(3)
+ complex(4) :: z
+ character(len=64) :: s
+
+ ! Round-trip
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_4)
+ read(s,*) r4
+ if (r4 /= -huge(1.0_4)) stop 1
+
+ s = '0X1.8P+0' ! = 1.5
+ read(s,*) r4
+ if (r4 /= 1.5_4) stop 2
+
+ s = '-0X1.P+0' ! = -1.0
+ read(s,*) r4
+ if (r4 /= -1.0_4) stop 3
+
+ ! Lowercase
+ s = '0x1.8p-1' ! = 0.75
+ read(s,*) r4
+ if (r4 /= 0.75_4) stop 4
+
+ ! Hex digit 'E' is not an exponent.
+ s = '0X1.EP+3' ! (1 + 14/16) * 8 = 15.0
+ read(s,*) r4
+ if (r4 /= 15.0_4) stop 5
+
+ ! Comma-separated list of hex values.
+ s = '0X1P0, 0X1.8P+1'
+ read(s,*) a, b
+ if (a /= 1.0_4 .or. b /= 3.0_4) stop 6
+
+ ! Using a repeat count
+ s = '3*0X1P+1'
+ read(s,*) arr
+ if (any(arr /= 2.0_4)) stop 7
+
+ ! Complex constant with hex real and imaginary parts.
+ s = '(0X1P0, 0X1.8P+1)'
+ read(s,*) z
+ if (z /= (1.0_4, 3.0_4)) stop 8
+end subroutine test04
+
+
+subroutine test08
+ real(8) :: r8, nx
+ character(len=64) :: s
+ namelist /nl8/ nx
+
+ ! Round-trip.
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_8)
+ read(s,*) r8
+ if (r8 /= -huge(1.0_8)) stop 10
+
+ ! Explicit hex: IEEE 754 representation of 1/3.
+ s = '0X1.5555555555555P-2'
+ read(s,*) r8
+ if (r8 /= 1.0_8 / 3.0_8) stop 11
+
+ ! pi, double precision.
+ s = '0X1.921FB54442D18P+1'
+ read(s,*) r8
+ if (abs(r8 - acos(-1.0_8)) > 2.0_8 * epsilon(r8)) stop 12
+
+ ! Hex value inside a NAMELIST.
+ nx = -999.0_8
+ s = '&nl8 nx=0X1.8P+3 /'
+ read(s,nml=nl8)
+ if (nx /= 12.0_8) stop 13
+
+end subroutine test08
+
+
+#ifdef __GFC_REAL_10__
+subroutine test10
+ real(10) :: r10
+ character(len=64) :: s
+
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_10)
+ read(s,*) r10
+ if (r10 /= -huge(1.0_10)) stop 14
+
+ s = '0X1.8P+0'
+ read(s,*) r10
+ if (r10 /= 1.5_10) stop 15
+
+end subroutine test10
+#else
+subroutine test10
+end subroutine test10
+#endif
+
+
+#ifdef __GFC_REAL_16__
+subroutine test16
+ real(16) :: r16
+ character(len=64) :: s
+
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_16)
+ read(s,*) r16
+ if (r16 /= -huge(1.0_16)) stop 16
+
+ s = '0X1.8P+0'
+ read(s,*) r16
+ if (r16 /= 1.5_16) stop 17
+
+end subroutine test16
+#else
+subroutine test16
+end subroutine test16
+#endif
+
+end program main
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 2b577baa7d3..f2179e2a1d8 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -1539,6 +1539,17 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
seen_dp = (c == '.') ? 1 : 0;
+ if (c == '0')
+ {
+ int c2 = next_char (dtp);
+ if (c2 == 'x' || c2 == 'X')
+ {
+ push_char (dtp, c2);
+ goto hex_real;
+ }
+ unget_char (dtp, c2);
+ }
+
for (;;)
{
if ((c = next_char (dtp)) == EOF)
@@ -1644,6 +1655,30 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
}
}
+ /* Hexadecimal format so collect the remaining characters.
+ The convert_real will validate it. */
+ hex_real:
+ for (;;)
+ {
+ if ((c = next_char (dtp)) == EOF)
+ goto bad;
+ switch (c)
+ {
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad;
+ /* Fall through. */
+
+ CASE_SEPARATORS:
+ case ')':
+ goto done;
+
+ default:
+ push_char (dtp, c);
+ break;
+ }
+ }
+
done:
unget_char (dtp, c);
push_char (dtp, '\0');
@@ -1878,6 +1913,17 @@ next:
switch (c)
{
CASE_DIGITS:
+ if (c == '0')
+ {
+ int c2 = next_char (dtp);
+ if (c2 == 'x' || c2 == 'X')
+ {
+ push_char (dtp, c);
+ push_char (dtp, c2);
+ goto hex_real;
+ }
+ unget_char (dtp, c2);
+ }
push_char (dtp, c);
break;
@@ -2018,6 +2064,17 @@ next:
push_char (dtp, c);
+ if (c == '0')
+ {
+ int c2 = next_char (dtp);
+ if (c2 == 'x' || c2 == 'X')
+ {
+ push_char (dtp, c2);
+ goto hex_real;
+ }
+ unget_char (dtp, c2);
+ }
+
real_loop:
for (;;)
{
@@ -2117,6 +2174,34 @@ next:
}
}
+ /* Hexadecimal-significand form: [sign] 0X hex-significand P
+ decimal-exp (F2023 13.7.2.3.2 para 7), also accepted on list-directed
+ input per the same rules as Fw.d editing. The '0X'/'0x' prefix has
+ already been pushed; collect the remaining characters (hex digits,
+ radix point, P/p exponent letter, exponent sign) verbatim up to the
+ next separator and let convert_real/strtod validate and parse the
+ whole thing, just as read_ex does for formatted EX input. */
+ hex_real:
+ for (;;)
+ {
+ c = next_char (dtp);
+ switch (c)
+ {
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_real;
+ /* Fall through. */
+
+ CASE_SEPARATORS:
+ case EOF:
+ goto done;
+
+ default:
+ push_char (dtp, c);
+ break;
+ }
+ }
+
done:
unget_char (dtp, c);
eat_separator (dtp);
