The following implements the last of the EX formatting work. The attached patch
has been regression tested on x86_64. The test case provided round trip testing
to ensure what we read is what we wrote.
OK for mainline?
Best regards,
Jerry
---
Fortran: [PR93727] Add EX format READ (read_ex)
Implement read_ex in libgfortran to handle EX edit-descriptor input
per Fortran 2023 13.7.2.3.6. The input field may contain:
* a hexadecimal-significand form (0X<sig>P<exp>) passed directly
to the C strtod/strtold family for exact bit-for-bit conversion;
* any form acceptable for Fw.d input (decimal fallback), including
INF and NAN representations.
For decimal input without a decimal point the d field of the EX.w.d
descriptor adjusts the exponent exactly as for Fw.d. BN/BZ blank
handling and the kP scale factor are also supported via the shared
decimal path.
Assisted by: Claude Sonnet 4.6
PR fortran/93727
libgfortran/ChangeLog:
* io/read.c (read_ex): New function implementing EX format read.
* io/io.h (read_ex): Declare.
* io/transfer.c (formatted_transfer_scalar_read): Add FMT_EX case
dispatching to read_ex.
gcc/testsuite/ChangeLog:
* gfortran.dg/EXformat_4.F90: New test covering EX format read
for kind=4 and 8 (always) and kind=10, 16 (when available):
hex-significand literals, lowercase prefix, negative binary
exponent, decimal fallback, d-field adjustment, INF/NAN, zero
field, and round-trips through write_ex.
---From ac5caffca8de75c6ad6026d930c1bc8a38ee0452 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 25 May 2026 21:13:19 -0700
Subject: [PATCH] Fortran: [PR93727] Add EX format READ (read_ex)
Implement read_ex in libgfortran to handle EX edit-descriptor input
per Fortran 2023 13.7.2.3.6. The input field may contain:
* a hexadecimal-significand form (0X<sig>P<exp>) passed directly
to the C strtod/strtold family for exact bit-for-bit conversion;
* any form acceptable for Fw.d input (decimal fallback), including
INF and NAN representations.
For decimal input without a decimal point the d field of the EX.w.d
descriptor adjusts the exponent exactly as for Fw.d. BN/BZ blank
handling and the kP scale factor are also supported via the shared
decimal path.
Assisted by: Claude Sonnet 4.6
PR fortran/93727
libgfortran/ChangeLog:
* io/read.c (read_ex): New function implementing EX format read.
* io/io.h (read_ex): Declare.
* io/transfer.c (formatted_transfer_scalar_read): Add FMT_EX case
dispatching to read_ex.
gcc/testsuite/ChangeLog:
* gfortran.dg/EXformat_4.F90: New test covering EX format read
for kind=4 and 8 (always) and kind=10, 16 (when available):
hex-significand literals, lowercase prefix, negative binary
exponent, decimal fallback, d-field adjustment, INF/NAN, zero
field, and round-trips through write_ex.
---
gcc/testsuite/gfortran.dg/EXformat_4.F90 | 172 +++++++++++
libgfortran/io/io.h | 3 +
libgfortran/io/read.c | 358 +++++++++++++++++++++++
libgfortran/io/transfer.c | 8 +
4 files changed, 541 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/EXformat_4.F90
diff --git a/gcc/testsuite/gfortran.dg/EXformat_4.F90 b/gcc/testsuite/gfortran.dg/EXformat_4.F90
new file mode 100644
index 00000000000..c90857ac3e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/EXformat_4.F90
@@ -0,0 +1,172 @@
+! { dg-do run }
+! PR93727 Test EX format READ (read_ex).
+! Covers: hex-significand input (0X...P...), decimal fallback, round-trips,
+! INF/NAN, and all supported real kinds.
+program main
+ implicit none
+ call test04
+ call test08
+ call test10
+ call test16
+
+contains
+
+subroutine test04
+ real(kind=4) :: r4
+ character(kind=1,len=40) :: s
+
+ ! Round-trip: write then read back.
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_4)
+ read(s,'(EX40.0)') r4
+ if (r4 /= -huge(1.0_4)) stop 1
+
+ s = ' '
+ write(s,'(EX0.0)') tiny(1.0_4)
+ read(s,'(EX40.0)') r4
+ if (r4 /= tiny(1.0_4)) stop 2
+
+ ! Explicit hex literal input.
+ s = '0X1.8P+0' ! = 1.5 exactly
+ read(s,'(EX40.0)') r4
+ if (r4 /= 1.5_4) stop 3
+
+ s = '-0X1.P+0' ! = -1.0
+ read(s,'(EX40.0)') r4
+ if (r4 /= -1.0_4) stop 4
+
+ ! Decimal fallback: no 0X prefix, ordinary E-style input.
+ s = '1.5E0'
+ read(s,'(EX40.0)') r4
+ if (r4 /= 1.5_4) stop 5
+
+ s = ' 1.5E2 '
+ read(s,'(EX40.0)') r4
+ if (r4 /= 150.0_4) stop 6
+
+ ! Zero field (blank record).
+ s = ' '
+ read(s,'(EX4.0)') r4
+ if (r4 /= 0.0_4) stop 7
+
+end subroutine test04
+
+
+subroutine test08
+ real(kind=8) :: r8
+ character(kind=1,len=40) :: s
+
+ ! Round-trip.
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_8)
+ read(s,'(EX40.0)') r8
+ if (r8 /= -huge(1.0_8)) stop 8
+
+ s = ' '
+ write(s,'(EX0.0)') tiny(1.0_8)
+ read(s,'(EX40.0)') r8
+ if (r8 /= tiny(1.0_8)) stop 9
+
+ ! Explicit hex: IEEE 754 representation of 1/3.
+ s = '0X1.5555555555555P-2'
+ read(s,'(EX40.0)') r8
+ if (r8 /= 1.0_8 / 3.0_8) stop 10
+
+ ! Negative hex.
+ s = '-0X1.8P+0' ! = -1.5
+ read(s,'(EX40.0)') r8
+ if (r8 /= -1.5_8) stop 11
+
+ ! Decimal fallback.
+ s = '3.14159265358979E0'
+ read(s,'(EX40.0)') r8
+ if (abs(r8 - 3.14159265358979_8) > 2.0_8 * epsilon(r8)) stop 12
+
+ ! Round-trip on an interesting value.
+ s = ' '
+ write(s,'(EX0.0)') -3.14159265358979_8 * 25.0_8
+ read(s,'(EX40.0)') r8
+ if (r8 /= -3.14159265358979_8 * 25.0_8) stop 13
+
+ ! Lowercase hex prefix and negative binary exponent.
+ s = '0x1.8p-1' ! = 0.75
+ read(s,'(EX40.0)') r8
+ if (r8 /= 0.75_8) stop 14
+
+ ! d-field: no decimal point in decimal input; d=2 places from right.
+ s = '12345 '
+ read(s,'(EX10.2)') r8
+ if (r8 /= 123.45_8) stop 15
+
+ ! INF and NaN input via decimal fallback path.
+ s = 'Inf'
+ read(s,'(EX40.0)') r8
+ if (r8 <= huge(r8)) stop 16
+
+ s = '-Infinity'
+ read(s,'(EX40.0)') r8
+ if (r8 >= -huge(r8)) stop 17
+
+ s = 'NaN'
+ read(s,'(EX40.0)') r8
+ if (r8 == r8) stop 18
+
+end subroutine test08
+
+
+#ifdef __GFC_REAL_10__
+subroutine test10
+ real(kind=10) :: r10
+ character(kind=1,len=40) :: s
+
+ ! Round-trip.
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_10)
+ read(s,'(EX40.0)') r10
+ if (r10 /= -huge(1.0_10)) stop 19
+
+ s = ' '
+ write(s,'(EX0.0)') tiny(1.0_10)
+ read(s,'(EX40.0)') r10
+ if (r10 /= tiny(1.0_10)) stop 20
+
+ ! Explicit hex: 1.5 = 0X1.8P+0
+ s = '0X1.8P+0'
+ read(s,'(EX40.0)') r10
+ if (r10 /= 1.5_10) stop 21
+
+end subroutine test10
+#else
+subroutine test10
+end subroutine test10
+#endif
+
+
+#ifdef __GFC_REAL_16__
+subroutine test16
+ real(kind=16) :: r16
+ character(kind=1,len=40) :: s
+
+ ! Round-trip.
+ s = ' '
+ write(s,'(EX0.0)') -huge(1.0_16)
+ read(s,'(EX40.0)') r16
+ if (r16 /= -huge(1.0_16)) stop 22
+
+ s = ' '
+ write(s,'(EX0.0)') tiny(1.0_16)
+ read(s,'(EX40.0)') r16
+ if (r16 /= tiny(1.0_16)) stop 23
+
+ ! Explicit hex: 1.5 = 0X1.8P+0
+ s = '0X1.8P+0'
+ read(s,'(EX40.0)') r16
+ if (r16 /= 1.5_16) stop 24
+
+end subroutine test16
+#else
+subroutine test16
+end subroutine test16
+#endif
+
+end program main
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 1fd0908859f..d131d9544c4 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -887,6 +887,9 @@ internal_proto(read_a);
extern void read_f (st_parameter_dt *, const fnode *, char *, int);
internal_proto(read_f);
+extern void read_ex (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_ex);
+
extern void read_l (st_parameter_dt *, const fnode *, char *, int);
internal_proto(read_l);
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index aeec725684b..047fff11643 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -1525,6 +1525,364 @@ bad_float:
}
+/* read_ex()-- Read a floating-point number with EX editing.
+ Per Fortran 2023 13.7.2.3.6 para 3, the input form is the same as for
+ Fw.d editing (13.7.2.3.2). That includes the hexadecimal-significand
+ form (13.7.2.3.2 para 7): [sign] 0X [hex-significand] P [decimal-exp].
+ Decimal mantissas and IEEE exceptional forms (INF, NAN) are also
+ accepted. Embedded blanks are not permitted within a hex float; C
+ strtod handles the 0x...p... form natively. */
+
+void
+read_ex (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
+{
+#define READEX_TMP 64
+ char tmp[READEX_TMP];
+ size_t buf_size = 0;
+ size_t w;
+ int seen_dp, exponent;
+ int exponent_sign;
+ const char *p;
+ char *buffer;
+ char *out;
+ int seen_int_digit;
+ int seen_dec_digit;
+
+ seen_dp = 0;
+ seen_int_digit = 0;
+ seen_dec_digit = 0;
+ exponent_sign = 1;
+ exponent = 0;
+ w = f->u.real.w;
+ buffer = tmp;
+
+ p = read_block_form (dtp, &w);
+ if (p == NULL)
+ return;
+ p = eat_leading_spaces (&w, (char *) p);
+ if (w == 0)
+ goto zero;
+
+ buf_size = w + 11;
+ if (buf_size > READEX_TMP)
+ buffer = xmalloc (buf_size);
+
+ out = buffer;
+
+ /* Optional sign. */
+ if (*p == '-' || *p == '+')
+ {
+ if (*p == '-')
+ *(out++) = '-';
+ ++p;
+ --w;
+ }
+
+ p = eat_leading_spaces (&w, (char *) p);
+ if (w == 0)
+ {
+ if (buf_size > READEX_TMP)
+ free (buffer);
+ goto zero;
+ }
+
+ /* IEEE exceptional specification: INF or NAN. */
+ if (unlikely (w >= 3 && (*p == 'i' || *p == 'I' || *p == 'n' || *p == 'N')))
+ {
+ int seen_paren = 0;
+ char *save = out;
+
+ while (w > 0)
+ {
+ *out = safe_tolower (*p);
+ switch (*p)
+ {
+ case ' ':
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ {
+ *out = '0';
+ break;
+ }
+ *out = '\0';
+ if (seen_paren == 1)
+ goto bad_float;
+ break;
+ case '(':
+ seen_paren++;
+ *out = '\0';
+ break;
+ case ')':
+ if (seen_paren++ != 1)
+ goto bad_float;
+ break;
+ default:
+ if (!safe_isalnum (*out))
+ goto bad_float;
+ }
+ --w;
+ ++p;
+ ++out;
+ }
+
+ *out = '\0';
+
+ if (seen_paren != 0 && seen_paren != 2)
+ goto bad_float;
+
+ if ((strcmp (save, "inf") == 0) || (strcmp (save, "infinity") == 0))
+ {
+ if (seen_paren)
+ goto bad_float;
+ }
+ else if (strcmp (save, "nan") != 0)
+ goto bad_float;
+
+ convert_infnan (dtp, dest, buffer, length);
+ if (buf_size > READEX_TMP)
+ free (buffer);
+ return;
+ }
+
+ /* Hexadecimal-significand number: 0X or 0x prefix.
+ Embedded blanks are forbidden; we stop at the first blank and let
+ convert_real report an error if the string is malformed. */
+ if (w >= 2 && *p == '0' && (p[1] == 'x' || p[1] == 'X'))
+ {
+ while (w > 0 && *p != ' ')
+ {
+ *(out++) = *p++;
+ --w;
+ }
+ *(out++) = '\0';
+
+ convert_real (dtp, dest, buffer, length);
+ if (buf_size > READEX_TMP)
+ free (buffer);
+ return;
+ }
+
+ /* Decimal floating-point fallback: same rules as Fw.d editing. */
+ while (w > 0)
+ {
+ switch (*p)
+ {
+ case ',':
+ if (dtp->u.p.current_unit->decimal_status != DECIMAL_COMMA)
+ goto bad_float;
+ if (seen_dp)
+ goto bad_float;
+ if (!seen_int_digit)
+ *(out++) = '0';
+ *(out++) = '.';
+ seen_dp = 1;
+ break;
+
+ case '.':
+ if (dtp->u.p.current_unit->decimal_status != DECIMAL_POINT)
+ goto bad_float;
+ if (seen_dp)
+ goto bad_float;
+ if (!seen_int_digit)
+ *(out++) = '0';
+ *(out++) = '.';
+ seen_dp = 1;
+ break;
+
+ case ' ':
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ {
+ *(out++) = '0';
+ goto found_digit;
+ }
+ else if (dtp->u.p.blank_status == BLANK_NULL)
+ break;
+ else
+ goto done;
+ /* Fall through. */
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ *(out++) = *p;
+found_digit:
+ if (!seen_dp)
+ seen_int_digit = 1;
+ else
+ seen_dec_digit = 1;
+ break;
+
+ case '-':
+ case '+':
+ goto exponent;
+
+ case 'e':
+ case 'E':
+ case 'd':
+ case 'D':
+ case 'q':
+ case 'Q':
+ ++p;
+ --w;
+ goto exponent;
+
+ default:
+ goto bad_float;
+ }
+
+ ++p;
+ --w;
+ }
+
+ /* No exponent seen; apply the scale factor. */
+ exponent = -dtp->u.p.scale_factor;
+ goto done;
+
+exponent:
+ p = eat_leading_spaces (&w, (char *) p);
+ if (*p == '-' || *p == '+')
+ {
+ if (*p == '-')
+ exponent_sign = -1;
+ ++p;
+ --w;
+ }
+
+ if (w == 0)
+ {
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ goto done;
+ else
+ goto bad_float;
+ }
+
+ if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
+ {
+ while (w > 0 && safe_isdigit (*p))
+ {
+ exponent *= 10;
+ exponent += *p - '0';
+ ++p;
+ --w;
+ }
+ while (w > 0)
+ {
+ if (*p != ' ')
+ goto bad_float;
+ ++p;
+ --w;
+ }
+ }
+ else
+ {
+ while (w > 0)
+ {
+ if (*p == ' ')
+ {
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ exponent *= 10;
+ else
+ assert (dtp->u.p.blank_status == BLANK_NULL);
+ }
+ else if (!safe_isdigit (*p))
+ goto bad_float;
+ else
+ {
+ exponent *= 10;
+ exponent += *p - '0';
+ }
+ ++p;
+ --w;
+ }
+ }
+
+ exponent *= exponent_sign;
+
+done:
+ if (!seen_dp)
+ exponent -= f->u.real.d;
+
+ if (seen_dp && !seen_dec_digit)
+ *(out++) = '0';
+ else if (!seen_int_digit && !seen_dec_digit)
+ {
+ notify_std (&dtp->common, GFC_STD_LEGACY,
+ "REAL input of style 'E+NN'");
+ *(out++) = '0';
+ }
+
+ if (exponent != 0)
+ {
+ int dig;
+
+ *(out++) = 'e';
+ if (exponent < 0)
+ {
+ *(out++) = '-';
+ exponent = -exponent;
+ }
+
+ if (exponent >= 10000)
+ goto bad_float;
+
+ for (dig = 3; dig >= 0; --dig)
+ {
+ out[dig] = (char) ('0' + exponent % 10);
+ exponent /= 10;
+ }
+ out += 4;
+ }
+ *(out++) = '\0';
+
+ convert_real (dtp, dest, buffer, length);
+ if (buf_size > READEX_TMP)
+ free (buffer);
+ return;
+
+zero:
+ switch (length)
+ {
+ case 4:
+ *((GFC_REAL_4 *) dest) = 0.0;
+ break;
+ case 8:
+ *((GFC_REAL_8 *) dest) = 0.0;
+ break;
+#ifdef HAVE_GFC_REAL_10
+ case 10:
+ *((GFC_REAL_10 *) dest) = 0.0;
+ break;
+#endif
+#ifdef HAVE_GFC_REAL_16
+ case 16:
+ *((GFC_REAL_16 *) dest) = 0.0;
+ break;
+#endif
+#ifdef HAVE_GFC_REAL_17
+ case 17:
+ *((GFC_REAL_17 *) dest) = 0.0;
+ break;
+#endif
+ default:
+ internal_error (&dtp->common, "Unsupported real kind during IO");
+ }
+ return;
+
+bad_float:
+ if (buf_size > READEX_TMP)
+ free (buffer);
+ generate_error (&dtp->common, LIBERROR_READ_VALUE,
+ "Bad value during floating point read");
+ next_record (dtp, 1);
+ return;
+}
+
+
/* read_x()-- Deal with the X/TR descriptor. We just read some data
and never look at it. */
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 99e90f3c803..49b211ba667 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1840,6 +1840,14 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
read_f (dtp, f, p, kind);
break;
+ case FMT_EX:
+ if (n == 0)
+ goto need_read_data;
+ if (require_type (dtp, BT_REAL, type, f))
+ return;
+ read_ex (dtp, f, p, kind);
+ break;
+
case FMT_F:
if (n == 0)
goto need_read_data;
--
2.54.0
