Re: [PATCH] PR93727 Add EX format rounding for truncated hex mantissa

Hi Jerry!

Am 27.05.26 um 3:12 AM schrieb Jerry D:
> The attached patch with assistance implements the various rounding modes 
> for the WRITE with EX hexadecimal float output.
> 
> This continues the effort to get the full EX support completed. A 
> followup patch will take care of the READ EX portion.
> 
> This has been regression tested on x86_64.
> 
> OK for mainline?

This looks good to me, so good for mainline.

I see one issue when compiling on x86_64-pc-linux-gnu: the snprintf
in libgfortran/io/write_float.def has a mismatch between the format
and the passed parameter (llX == long long unsigned int vs.
GFC_UINTEGER_8).  I tried to locally cast the passed value, see
attached patch.  This got rid of the warning here.

Can you try yourself?  Maybe this also fixes the failures on Power.

Thanks for the patch!

Harald

> Regards,
> 
> Jerry
> -----
> Fortran: [PR93727] Add EX format rounding for truncated hex mantissa
> 
> Implement proper rounding of the hex mantissa in write_ex when the
> user specifies a d smaller than full precision.  All Fortran ROUND=
> modes are supported: ROUND_NEAREST (ties-to-even), ROUND_COMPATIBLE
> (ties away from zero), ROUND_UP, ROUND_DOWN, and ROUND_ZERO.
> ROUND_PROCDEFINED and ROUND_UNSPECIFIED default to ROUND_NEAREST on
> IEEE 754 systems, consistent with the decimal format behaviour.
> 
> Carry propagation handles the case where incrementing a string of
> trailing F hex digits reaches the integer digit; if that overflows
> (F → 16) the output is normalized by setting the integer digit to 8
> and incrementing the binary exponent by one.
> 
> Assisted by: Claude Sonnet 4.6
> 
>      PR fortran/93727
> 
> libgfortran/ChangeLog:
> 
>      * io/write.c (write_ex): Replace simple truncation with
>      rounding-aware logic respecting dtp round_status.  Add carry
>      propagation and integer-digit normalization.
> 
> gcc/testsuite/ChangeLog:
> 
>      * gfortran.dg/EXformat_3.F90: New test covering rounding for
>      KIND=4, 8, 10, and 16: clear round-up, ties-to-even (truncate
>      and round-up cases), carry propagation, and normalization.
>      * gfortran.dg/EXrounding.F90: New test checking the various
>      rounding modes for all kinds.
> ---

diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index da31c8af51c..8b634f74bb2 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -175,10 +175,10 @@ get_float_hex_string (const void *source, int kind, char *buffer,
 	frac_part = (GFC_UINTEGER_8) scalbn (mant - (double) int_part, 56 - 4);
 	if (is_negative)
 	  result = snprintf (buffer, 25, "-0X%X.%13.13llXP%+d", int_part,
-			     (GFC_UINTEGER_8) frac_part, expon);
+			     (long long unsigned) frac_part, expon);
 	else
 	  result = snprintf (buffer, 25, "0X%X.%13.13llXP%+d", int_part,
-			     (GFC_UINTEGER_8) frac_part, expon);
+			     (long long unsigned) frac_part, expon);
       }
       break;
 #ifdef HAVE_GFC_REAL_10
@@ -235,10 +235,10 @@ get_float_hex_string (const void *source, int kind, char *buffer,
 	frac_part = (GFC_UINTEGER_8) scalbnl (mant - (GFC_REAL_10) int_part, 64 - 4);
 	if (is_negative)
 	  result = snprintf (buffer, 28, "-0X%X.%15.15llXP%+d", int_part,
-			     (GFC_UINTEGER_8) frac_part, expon);
+			     (long long unsigned) frac_part, expon);
 	else
 	  result = snprintf (buffer, 28, "0X%X.%15.15llXP%+d", int_part,
-			     (GFC_UINTEGER_8) frac_part, expon);
+			     (long long unsigned) frac_part, expon);
       }
       break;
 #endif
@@ -302,12 +302,12 @@ get_float_hex_string (const void *source, int kind, char *buffer,
 	frac_lo = (GFC_UINTEGER_8) GFC_REAL_16_SCALBN (frac_lo_val, 112);
 	if (is_negative)
 	  result = snprintf (buffer, 42, "-0X%X.%14.14llX%14.14llXP%+d",
-			     int_part, (GFC_UINTEGER_8) frac_hi,
-			     (GFC_UINTEGER_8) frac_lo, expon);
+			     int_part, (long long unsigned) frac_hi,
+			     (long long unsigned) frac_lo, expon);
 	else
 	  result = snprintf (buffer, 42, "0X%X.%14.14llX%14.14llXP%+d",
-			     int_part, (GFC_UINTEGER_8) frac_hi,
-			     (GFC_UINTEGER_8) frac_lo, expon);
+			     int_part, (long long unsigned) frac_hi,
+			     (long long unsigned) frac_lo, expon);
       }
       break;
 #endif /* HAVE_GFC_REAL_16  */