diff mbox

fortran/PR58113

Message ID DUB122-W2900585FF8528B62D67CC2E42F0@phx.gbl
State New
Headers show

Commit Message

Bernd Edlinger Sept. 25, 2013, 5:35 p.m. UTC
Hi,

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?

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

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

Comments

Tobias Burnus Sept. 25, 2013, 7 p.m. UTC | #1
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.

Tobias

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

> changelog-round4.txt
>
>
> 2013-09-25  Bernd Edlinger<bernd.edlinger@hotmail.de>
>
> 	PR fortran/58113
> 	* gfortran.dg/round_4.f90: Check for rounding support.
>
>
> patch-round4.diff
>
>
> --- gcc/testsuite/gfortran.dg/round_4.f90	2013-07-21 13:54:27.000000000 +0200
> +++ gcc/testsuite/gfortran.dg/round_4.f90	2013-08-23 10:16:32.000000000 +0200
> @@ -27,6 +27,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 +66,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
>
Bernd Edlinger Sept. 26, 2013, 9:25 a.m. UTC | #2
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.
2013-09-25  Bernd Edlinger  <bernd.edlinger@hotmail.de>

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

Patch

--- gcc/testsuite/gfortran.dg/round_4.f90	2013-07-21 13:54:27.000000000 +0200
+++ gcc/testsuite/gfortran.dg/round_4.f90	2013-08-23 10:16:32.000000000 +0200
@@ -27,6 +27,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 +66,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