Re: [PATCH] fortran/PR58113

[Tobias Burnus <burnus at net-b dot de>]

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