re PR fortran/38718 (some simplifiers for elemental intrinsics missing; required for init expressions)
PR fortran/38718 * intrinsic.c (add_functions): Add simplifiers for ISNAN, IS_IOSTAT_END and IS_IOSTAT_EOR. * intrinsic.h (gfc_simplify_is_iostat_end, * gfc_simplify_is_iostat_eor, gfc_simplify_isnan): New prototypes. * intrinsic.c (gfc_simplify_is_iostat_end, * gfc_simplify_is_iostat_eor, gfc_simplify_isnan): New functions. * gfortran.dg/is_iostat_end_eor_2.f90: New test. * gfortran.dg/nan_5.f90: New test. From-SVN: r148367
This commit is contained in:
parent
e8d4f3fcb2
commit
4ec80803fb
|
@ -1,3 +1,13 @@
|
||||||
|
2009-06-11 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/38718
|
||||||
|
* intrinsic.c (add_functions): Add simplifiers for ISNAN,
|
||||||
|
IS_IOSTAT_END and IS_IOSTAT_EOR.
|
||||||
|
* intrinsic.h (gfc_simplify_is_iostat_end, gfc_simplify_is_iostat_eor,
|
||||||
|
gfc_simplify_isnan): New prototypes.
|
||||||
|
* intrinsic.c (gfc_simplify_is_iostat_end, gfc_simplify_is_iostat_eor,
|
||||||
|
gfc_simplify_isnan): New functions.
|
||||||
|
|
||||||
2009-06-11 Jakub Jelinek <jakub@redhat.com>
|
2009-06-11 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
* interface.c (fold_unary): Rename to...
|
* interface.c (fold_unary): Rename to...
|
||||||
|
|
|
@ -1845,18 +1845,21 @@ add_functions (void)
|
||||||
|
|
||||||
add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
|
add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
|
||||||
CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
|
CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
|
||||||
gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED);
|
gfc_check_i, gfc_simplify_is_iostat_end, NULL,
|
||||||
|
i, BT_INTEGER, 0, REQUIRED);
|
||||||
|
|
||||||
make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
|
make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
|
||||||
|
|
||||||
add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
|
add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
|
||||||
CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
|
CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
|
||||||
gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED);
|
gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
|
||||||
|
i, BT_INTEGER, 0, REQUIRED);
|
||||||
|
|
||||||
make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
|
make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
|
||||||
|
|
||||||
add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL,
|
add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
|
||||||
dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL,
|
BT_LOGICAL, dl, GFC_STD_GNU,
|
||||||
|
gfc_check_isnan, gfc_simplify_isnan, NULL,
|
||||||
x, BT_REAL, 0, REQUIRED);
|
x, BT_REAL, 0, REQUIRED);
|
||||||
|
|
||||||
make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
|
make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
|
||||||
|
|
|
@ -260,6 +260,9 @@ gfc_expr *gfc_simplify_long (gfc_expr *);
|
||||||
gfc_expr *gfc_simplify_ifix (gfc_expr *);
|
gfc_expr *gfc_simplify_ifix (gfc_expr *);
|
||||||
gfc_expr *gfc_simplify_idint (gfc_expr *);
|
gfc_expr *gfc_simplify_idint (gfc_expr *);
|
||||||
gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
|
gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
|
||||||
|
gfc_expr *gfc_simplify_is_iostat_end (gfc_expr *);
|
||||||
|
gfc_expr *gfc_simplify_is_iostat_eor (gfc_expr *);
|
||||||
|
gfc_expr *gfc_simplify_isnan (gfc_expr *);
|
||||||
gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *);
|
gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *);
|
||||||
gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
|
gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||||
gfc_expr *gfc_simplify_kind (gfc_expr *);
|
gfc_expr *gfc_simplify_kind (gfc_expr *);
|
||||||
|
|
|
@ -2625,6 +2625,54 @@ gfc_simplify_ior (gfc_expr *x, gfc_expr *y)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
gfc_expr *
|
||||||
|
gfc_simplify_is_iostat_end (gfc_expr *x)
|
||||||
|
{
|
||||||
|
gfc_expr *result;
|
||||||
|
|
||||||
|
if (x->expr_type != EXPR_CONSTANT)
|
||||||
|
return NULL;
|
||||||
|
|
||||||
|
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
|
||||||
|
&x->where);
|
||||||
|
result->value.logical = (mpz_cmp_si (x->value.integer, LIBERROR_END) == 0);
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
gfc_expr *
|
||||||
|
gfc_simplify_is_iostat_eor (gfc_expr *x)
|
||||||
|
{
|
||||||
|
gfc_expr *result;
|
||||||
|
|
||||||
|
if (x->expr_type != EXPR_CONSTANT)
|
||||||
|
return NULL;
|
||||||
|
|
||||||
|
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
|
||||||
|
&x->where);
|
||||||
|
result->value.logical = (mpz_cmp_si (x->value.integer, LIBERROR_EOR) == 0);
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
gfc_expr *
|
||||||
|
gfc_simplify_isnan (gfc_expr *x)
|
||||||
|
{
|
||||||
|
gfc_expr *result;
|
||||||
|
|
||||||
|
if (x->expr_type != EXPR_CONSTANT)
|
||||||
|
return NULL;
|
||||||
|
|
||||||
|
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
|
||||||
|
&x->where);
|
||||||
|
result->value.logical = mpfr_nan_p (x->value.real);
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
gfc_expr *
|
gfc_expr *
|
||||||
gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
|
gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,3 +1,9 @@
|
||||||
|
2009-06-11 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/38718
|
||||||
|
* gfortran.dg/is_iostat_end_eor_2.f90: New test.
|
||||||
|
* gfortran.dg/nan_5.f90: New test.
|
||||||
|
|
||||||
2009-06-10 Nathan Froyd <froydnj@codesourcery.com>
|
2009-06-10 Nathan Froyd <froydnj@codesourcery.com>
|
||||||
|
|
||||||
* gcc.target/arm/neon-modes-1.c: New test.
|
* gcc.target/arm/neon-modes-1.c: New test.
|
||||||
|
|
|
@ -0,0 +1,39 @@
|
||||||
|
! Check that we correctly simplify IS_IOSTAT_END and IS_IOSTAT_EOR.
|
||||||
|
! Not very useful, but required by the standards
|
||||||
|
!
|
||||||
|
! This test relies on the error numbers for END and EOR being -1 and -2.
|
||||||
|
! This is good to actual
|
||||||
|
!
|
||||||
|
! { dg-do compile }
|
||||||
|
!
|
||||||
|
|
||||||
|
use iso_fortran_env, only : iostat_end, iostat_eor
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(-1))) :: a
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(-1_1))) :: b
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(-1_2))) :: c
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(-1_4))) :: d
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(-1_8))) :: e
|
||||||
|
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(-2))) :: f
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(-2_1))) :: g
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(-2_2))) :: h
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(-2_4))) :: i
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(-2_8))) :: j
|
||||||
|
|
||||||
|
integer(kind=merge(0, 4, is_iostat_eor(-1))) :: k
|
||||||
|
integer(kind=merge(0, 4, is_iostat_end(-2))) :: l
|
||||||
|
|
||||||
|
integer(kind=merge(0, 4, is_iostat_eor(0))) :: m
|
||||||
|
integer(kind=merge(0, 4, is_iostat_end(0))) :: n
|
||||||
|
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(0))) :: o ! { dg-error "not supported for type" }
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(0))) :: p ! { dg-error "not supported for type" }
|
||||||
|
|
||||||
|
integer(kind=merge(4, 0, is_iostat_eor(iostat_eor))) :: q
|
||||||
|
integer(kind=merge(4, 0, is_iostat_end(iostat_end))) :: r
|
||||||
|
integer(kind=merge(0, 4, is_iostat_end(iostat_eor))) :: s
|
||||||
|
integer(kind=merge(0, 4, is_iostat_eor(iostat_end))) :: t
|
||||||
|
|
||||||
|
end
|
|
@ -0,0 +1,28 @@
|
||||||
|
! Check that we correctly simplify ISNAN
|
||||||
|
!
|
||||||
|
! { dg-do compile }
|
||||||
|
!
|
||||||
|
! { dg-options "-fno-range-check" }
|
||||||
|
! { dg-options "-fno-range-check -mieee" { target alpha*-*-* sh*-*-* } }
|
||||||
|
! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
real, parameter :: inf = 2 * huge(inf)
|
||||||
|
real, parameter :: nan1 = 0. / 0.
|
||||||
|
real, parameter :: nan2 = 1.5 * nan1
|
||||||
|
real, parameter :: nan3 = inf / inf
|
||||||
|
real, parameter :: nan4 = inf - inf
|
||||||
|
real, parameter :: nan5 = 0. * inf
|
||||||
|
real, parameter :: normal = 42.
|
||||||
|
|
||||||
|
integer(kind=merge(4, 0, isnan(nan1))) :: a
|
||||||
|
integer(kind=merge(4, 0, isnan(nan2))) :: b
|
||||||
|
integer(kind=merge(4, 0, isnan(nan3))) :: c
|
||||||
|
integer(kind=merge(4, 0, isnan(nan4))) :: d
|
||||||
|
integer(kind=merge(4, 0, isnan(nan5))) :: e
|
||||||
|
|
||||||
|
integer(kind=merge(0, 4, isnan(inf))) :: f
|
||||||
|
integer(kind=merge(0, 4, isnan(-inf))) :: g
|
||||||
|
integer(kind=merge(0, 4, isnan(normal))) :: h
|
||||||
|
|
||||||
|
end
|
Loading…
Reference in New Issue