[prev in list] [next in list] [prev in thread] [next in thread] 

List:       gcc-fortran
Subject:    RE: [PATCH] fortran/PR58113
From:       Bernd Edlinger <bernd.edlinger () hotmail ! de>
Date:       2013-09-26 9:25:54
Message-ID: DUB122-W44C93BBB5986C0C39698D8E4280 () phx ! gbl
[Download RAW message or body]

On Wed, 25 Sep 2013 21:00:33, Tobias Burnus wrote:
>
> Bernd Edlinger wrote:
>> this test case fails very often, and the reason is not in GCC but
>> in a missing glibc rounding support for strtod.
>>
>> This patch fixes the test case, to first determine if the
>> rounding support is available. This is often the case for real(16)
>> thru the libquadmath. So even in cases where the test case usually
>> fails it still tests something with this patch.
>>
>> Ok for trunk?
>
>
> First, for Fortran patches, it helps if you CC fortran@ as otherwise the
> email might be missed.
>
> Your change doesn't really directly check whether strtod handles
> rounding but whether libgfortran (invoking strtod) supports up/down
> rounding.
>
> Hence, after your patch, one effectively checks - given that up/down
> rounding works (or at least produces different values) - that the
> nearest/zero/up/down give the correct result.
>
> As only few strtod implementations currently support rounding, it is
> probably the best approach. However, I think it merits a comment making
> clear what it now checked (and what isn't). Maybe something along my
> paragraph (but polished) - and removing the then obsoleted parts of the
> existing comment.
>
> Except for the comment update, the patch looks fine to me.
>

OK, I used some of your wordings to update the comment.

I assume it's OK now.

> Tobias
>
> PS: I wonder whether there is a good way to do rounded strtod without
> relying on the system's libc to handle it.
>

Apparently the real(16) aka libquadmath has an own implementation
for strtod, that handles all rounding stuff the right way.

Probably it should be possible to locate that code and rework it for the
other possible real precisions, that currently rely on glibc's strtod.

However I will likely not have time for that :(

Bernd. 		 	   		  
["changelog-round4.txt" (text/plain)]

2013-09-25  Bernd Edlinger  <bernd.edlinger@hotmail.de>

	PR fortran/58113
	* gfortran.dg/round_4.f90: Check for rounding support.


["patch-round4.diff" (application/octet-stream)]

--- gcc/testsuite/gfortran.dg/round_4.f90	2013-07-21 13:54:27.000000000 +0200
+++ gcc/testsuite/gfortran.dg/round_4.f90	2013-09-26 11:13:41.340038532 +0200
@@ -6,12 +6,18 @@
 ! Test whether I/O rounding works. Uses internally (libgfortran) strtod
 ! for the conversion - and sets the CPU rounding mode accordingly.
 !
+! Only few strtod implementations currently support rounding. Therefore
+! we use a heuristic to determine if the rounding support is available.
+! The assumption is that if strtod gives *different* results for up/down
+! rounding, then it will give *correct* results for nearest/zero/up/down
+! rounding too. And that is what is effectively checked.
+!
 ! If it doesn't work on your system, please check whether strtod handles
-! rounding and whether your system is supported in libgfortran/config/fpu*.c
+! rounding correctly and whether your system is supported in
+! libgfortran/config/fpu*.c
 !
 ! Please only add ... run { target { ! { triplets } } } if it is unfixable
-! on your target - and a note why (strtod doesn't handle it, no rounding
-! support, etc.)
+! on your target - and a note why (strtod has broken rounding support, etc.)
 !
 program main
   use iso_fortran_env
@@ -27,6 +33,17 @@
   real(xp) :: r10p, r10m, ref10u, ref10d
   real(qp) :: r16p, r16m, ref16u, ref16d
   character(len=20) :: str, round
+  logical :: rnd4, rnd8, rnd10, rnd16
+
+  ! Test for which types glibc's strtod function supports rounding
+  str = '0.01 0.01 0.01 0.01'
+  read (str, *, round='up') r4p, r8p, r10p, r16p
+  read (str, *, round='down') r4m, r8m, r10m, r16m
+  rnd4 = r4p /= r4m
+  rnd8 = r8p /= r8m
+  rnd10 = r10p /= r10m
+  rnd16 = r16p /= r16m
+!  write (*, *) rnd4, rnd8, rnd10, rnd16
 
   ref4u = 0.100000001_4
   ref8u = 0.10000000000000001_8
@@ -55,40 +72,40 @@
 
   round = 'up'
   call t()
-  if (r4p  /= ref4u  .or. r4m  /= -ref4d)  call abort()
-  if (r8p  /= ref8u  .or. r8m  /= -ref8d)  call abort()
-  if (r10p /= ref10u .or. r10m /= -ref10d) call abort()
-  if (r16p /= ref16u .or. r16m /= -ref16d) call abort()
+  if (rnd4  .and. (r4p  /= ref4u  .or. r4m  /= -ref4d))  call abort()
+  if (rnd8  .and. (r8p  /= ref8u  .or. r8m  /= -ref8d))  call abort()
+  if (rnd10 .and. (r10p /= ref10u .or. r10m /= -ref10d)) call abort()
+  if (rnd16 .and. (r16p /= ref16u .or. r16m /= -ref16d)) call abort()
 
   round = 'down'
   call t()
-  if (r4p  /= ref4d  .or. r4m  /= -ref4u)  call abort()
-  if (r8p  /= ref8d  .or. r8m  /= -ref8u)  call abort()
-  if (r10p /= ref10d .or. r10m /= -ref10u) call abort()
-  if (r16p /= ref16d .or. r16m /= -ref16u) call abort()
+  if (rnd4  .and. (r4p  /= ref4d  .or. r4m  /= -ref4u))  call abort()
+  if (rnd8  .and. (r8p  /= ref8d  .or. r8m  /= -ref8u))  call abort()
+  if (rnd10 .and. (r10p /= ref10d .or. r10m /= -ref10u)) call abort()
+  if (rnd16 .and. (r16p /= ref16d .or. r16m /= -ref16u)) call abort()
 
   round = 'zero'
   call t()
-  if (r4p  /= ref4d  .or. r4m  /= -ref4d)  call abort()
-  if (r8p  /= ref8d  .or. r8m  /= -ref8d)  call abort()
-  if (r10p /= ref10d .or. r10m /= -ref10d) call abort()
-  if (r16p /= ref16d .or. r16m /= -ref16d) call abort()
+  if (rnd4  .and. (r4p  /= ref4d  .or. r4m  /= -ref4d))  call abort()
+  if (rnd8  .and. (r8p  /= ref8d  .or. r8m  /= -ref8d))  call abort()
+  if (rnd10 .and. (r10p /= ref10d .or. r10m /= -ref10d)) call abort()
+  if (rnd16 .and. (r16p /= ref16d .or. r16m /= -ref16d)) call abort()
 
   round = 'nearest'
   call t()
-  if (r4p  /= ref4u  .or. r4m  /= -ref4u)  call abort()
-  if (r8p  /= ref8u  .or. r8m  /= -ref8u)  call abort()
-  if (r10p /= ref10u .or. r10m /= -ref10u) call abort()
-  if (r16p /= ref16u .or. r16m /= -ref16u) call abort()
+  if (rnd4  .and. (r4p  /= ref4u  .or. r4m  /= -ref4u))  call abort()
+  if (rnd8  .and. (r8p  /= ref8u  .or. r8m  /= -ref8u))  call abort()
+  if (rnd10 .and. (r10p /= ref10u .or. r10m /= -ref10u)) call abort()
+  if (rnd16 .and. (r16p /= ref16u .or. r16m /= -ref16u)) call abort()
 
 ! Same as nearest (but rounding towards zero if there is a tie
 ! [does not apply here])
   round = 'compatible'
   call t()
-  if (r4p  /= ref4u  .or. r4m  /= -ref4u)  call abort()
-  if (r8p  /= ref8u  .or. r8m  /= -ref8u)  call abort()
-  if (r10p /= ref10u .or. r10m /= -ref10u) call abort()
-  if (r16p /= ref16u .or. r16m /= -ref16u) call abort()
+  if (rnd4  .and. (r4p  /= ref4u  .or. r4m  /= -ref4u))  call abort()
+  if (rnd8  .and. (r8p  /= ref8u  .or. r8m  /= -ref8u))  call abort()
+  if (rnd10 .and. (r10p /= ref10u .or. r10m /= -ref10u)) call abort()
+  if (rnd16 .and. (r16p /= ref16u .or. r16m /= -ref16u)) call abort()
 contains
   subroutine t()
 !    print *, round


[prev in list] [next in list] [prev in thread] [next in thread]