diff mbox series

fortran: Implement list directed read of hex float formats.

Message ID 3808aeaf-10e8-4e9d-8fb7-9d5cebe5bb00@gmail.com
State New
Headers
Series fortran: Implement list directed read of hex float formats. |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 success Build passed
linaro-tcwg-bot/tcwg_simplebootstrap_build--master-arm-bootstrap success Build passed
linaro-tcwg-bot/tcwg_gcc_build--master-arm success Build passed
linaro-tcwg-bot/tcwg_simplebootstrap_build--master-aarch64-bootstrap success Build passed

Commit Message

Jerry DeLisle July 16, 2026, 7:45 p.m. UTC 
  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.

---

Comments

Jerry DeLisle July 18, 2026, 8:01 p.m. UTC | #1 
ping

On 7/16/26 12:45 PM, Jerry D wrote:
> 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.
> 
> ---
Jerry DeLisle July 19, 2026, 3:37 p.m. UTC | #2 
The master branch has been updated by Jerry DeLisle <jvdelisle@gcc.gnu.org>:

https://gcc.gnu.org/g:73e6f2de0e606bf312377ac2dafec3bbf095241a

commitr17-2529-g73e6f2de0e606bf312377ac2dafec3bbf095241a <https://gcc.gnu.org/cgit/gcc/commit/?id=73e6f2de0e606bf312377ac2dafec3bbf095241a>


On 7/18/26 10:38 PM, Steve Kargl wrote:
> On 7/18/26 13:01, Jerry D wrote:
>> ping
>>
>> On 7/16/26 12:45 PM, Jerry D wrote:
>>> 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?
>>>
>
> Yes.  Thanks for the patch.
>
diff mbox series

Patch

commit 850dd8c506e4847fbb510543fbcef03904f3a976
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
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);