re PR fortran/32048 (max/min and NaN)
PR fortran/32048 * f95-lang.c (gfc_init_builtin_functions): Add declaration for __builtin_isnan. * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Handled NaNs. * gfortran.dg/nan_1.f90: New test. From-SVN: r127019
This commit is contained in:
François-Xavier Coudert
parent
6ea2b70d9c
commit
5fcb93f138
3 changed files with 141 additions and 3 deletions
|
|
@ -1004,6 +1004,11 @@ gfc_init_builtin_functions (void)
|
|||
"malloc", false);
|
||||
DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
|
||||
|
||||
tmp = tree_cons (NULL_TREE, void_type_node, void_list_node);
|
||||
ftype = build_function_type (integer_type_node, tmp);
|
||||
gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
|
||||
"__builtin_isnan", true);
|
||||
|
||||
#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
|
||||
builtin_types[(int) ENUM] = VALUE;
|
||||
#define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
|
||||
|
|
|
|||
|
|
@ -1407,11 +1407,11 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
|
|||
/* Get the minimum/maximum value of all the parameters.
|
||||
minmax (a1, a2, a3, ...)
|
||||
{
|
||||
if (a2 .op. a1)
|
||||
if (a2 .op. a1 || isnan(a1))
|
||||
mvar = a2;
|
||||
else
|
||||
mvar = a1;
|
||||
if (a3 .op. mvar)
|
||||
if (a3 .op. mvar || isnan(mvar))
|
||||
mvar = a3;
|
||||
...
|
||||
return mvar
|
||||
|
|
@ -1487,7 +1487,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
|
|||
elsecase = build2_v (MODIFY_EXPR, mvar, limit);
|
||||
for (i = 1, argexpr = argexpr->next; i < nargs; i++)
|
||||
{
|
||||
tree cond;
|
||||
tree cond, isnan;
|
||||
|
||||
val = args[i];
|
||||
|
||||
|
|
@ -1509,6 +1509,15 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
|
|||
thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));
|
||||
|
||||
tmp = build2 (op, boolean_type_node, convert (type, val), limit);
|
||||
|
||||
/* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to
|
||||
__builtin_isnan might be made dependent on that module being loaded,
|
||||
to help performance of programs that don't rely on IEEE semantics. */
|
||||
if (FLOAT_TYPE_P (TREE_TYPE (limit)))
|
||||
{
|
||||
isnan = build_call_expr (built_in_decls[BUILT_IN_ISNAN], 1, limit);
|
||||
tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, isnan);
|
||||
}
|
||||
tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
|
||||
|
||||
if (cond != NULL_TREE)
|
||||
|
|
|
|||
124
gcc/testsuite/gfortran.dg/nan_1.f90
Normal file
124
gcc/testsuite/gfortran.dg/nan_1.f90
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
! Test if MIN and MAX intrinsics behave correctly when passed NaNs
|
||||
! as arguments
|
||||
!
|
||||
! { dg-do run }
|
||||
!
|
||||
module aux
|
||||
interface isnan
|
||||
module procedure isnan_r
|
||||
module procedure isnan_d
|
||||
end interface isnan
|
||||
|
||||
interface isinf
|
||||
module procedure isinf_r
|
||||
module procedure isinf_d
|
||||
end interface isinf
|
||||
contains
|
||||
|
||||
pure function isnan_r(x) result (isnan)
|
||||
logical :: isnan
|
||||
real, intent(in) :: x
|
||||
|
||||
isnan = (.not.(x == x))
|
||||
end function isnan_r
|
||||
|
||||
pure function isnan_d(x) result (isnan)
|
||||
logical :: isnan
|
||||
double precision, intent(in) :: x
|
||||
|
||||
isnan = (.not.(x == x))
|
||||
end function isnan_d
|
||||
|
||||
pure function isinf_r(x) result (isinf)
|
||||
logical :: isinf
|
||||
real, intent(in) :: x
|
||||
|
||||
isinf = (x > huge(x)) .or. (x < -huge(x))
|
||||
end function isinf_r
|
||||
|
||||
pure function isinf_d(x) result (isinf)
|
||||
logical :: isinf
|
||||
double precision, intent(in) :: x
|
||||
|
||||
isinf = (x > huge(x)) .or. (x < -huge(x))
|
||||
end function isinf_d
|
||||
end module aux
|
||||
|
||||
program test
|
||||
use aux
|
||||
implicit none
|
||||
real :: nan, large, inf
|
||||
|
||||
! Create a NaN and check it
|
||||
nan = 0
|
||||
nan = nan / nan
|
||||
if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
|
||||
.or. nan <= nan) call abort
|
||||
if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
|
||||
(.not. isnan(real(nan,kind=kind(2.d0))))) call abort
|
||||
|
||||
! Create an INF and check it
|
||||
large = huge(large)
|
||||
inf = 2 * large
|
||||
if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
|
||||
if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
|
||||
|
||||
! Check that MIN and MAX behave correctly
|
||||
if (max(2.0, nan) /= 2.0) call abort
|
||||
if (min(2.0, nan) /= 2.0) call abort
|
||||
if (max(nan, 2.0) /= 2.0) call abort
|
||||
if (min(nan, 2.0) /= 2.0) call abort
|
||||
|
||||
if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
|
||||
if (.not. isnan(min(nan,nan))) call abort
|
||||
if (.not. isnan(max(nan,nan))) call abort
|
||||
|
||||
! Same thing, with more arguments
|
||||
|
||||
if (max(3.0, 2.0, nan) /= 3.0) call abort
|
||||
if (min(3.0, 2.0, nan) /= 2.0) call abort
|
||||
if (max(3.0, nan, 2.0) /= 3.0) call abort
|
||||
if (min(3.0, nan, 2.0) /= 2.0) call abort
|
||||
if (max(nan, 3.0, 2.0) /= 3.0) call abort
|
||||
if (min(nan, 3.0, 2.0) /= 2.0) call abort
|
||||
|
||||
if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
|
||||
|
||||
if (.not. isnan(min(nan,nan,nan))) call abort
|
||||
if (.not. isnan(max(nan,nan,nan))) call abort
|
||||
if (.not. isnan(min(nan,nan,nan,nan))) call abort
|
||||
if (.not. isnan(max(nan,nan,nan,nan))) call abort
|
||||
if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
|
||||
if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
|
||||
|
||||
! Large values, INF and NaNs
|
||||
if (.not. isinf(max(large, inf))) call abort
|
||||
if (isinf(min(large, inf))) call abort
|
||||
if (.not. isinf(max(nan, large, inf))) call abort
|
||||
if (isinf(min(nan, large, inf))) call abort
|
||||
if (.not. isinf(max(large, nan, inf))) call abort
|
||||
if (isinf(min(large, nan, inf))) call abort
|
||||
if (.not. isinf(max(large, inf, nan))) call abort
|
||||
if (isinf(min(large, inf, nan))) call abort
|
||||
|
||||
if (.not. isinf(min(-large, -inf))) call abort
|
||||
if (isinf(max(-large, -inf))) call abort
|
||||
if (.not. isinf(min(nan, -large, -inf))) call abort
|
||||
if (isinf(max(nan, -large, -inf))) call abort
|
||||
if (.not. isinf(min(-large, nan, -inf))) call abort
|
||||
if (isinf(max(-large, nan, -inf))) call abort
|
||||
if (.not. isinf(min(-large, -inf, nan))) call abort
|
||||
if (isinf(max(-large, -inf, nan))) call abort
|
||||
|
||||
end program test
|
||||
|
||||
! { dg-final { cleanup-modules "aux" } }
|
||||
Loading…
Add table
Reference in a new issue