From 96098ab0564305340a17a5bc18f80ef25455a9fc Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Thu, 11 Jun 2009 07:47:35 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148367 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 +++++ gcc/fortran/intrinsic.c | 11 ++++-- gcc/fortran/intrinsic.h | 3 ++ gcc/fortran/simplify.c | 48 +++++++++++++++++++++++ gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90 | 39 ++++++++++++++++++ gcc/testsuite/gfortran.dg/nan_5.f90 | 28 +++++++++++++ 7 files changed, 141 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/nan_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 68ad797596e..1a2f41b2456 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2009-06-11 Francois-Xavier Coudert + + 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 * interface.c (fold_unary): Rename to... diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 014ea11d3e8..7bb10ec245b 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1845,18 +1845,21 @@ add_functions (void) add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, 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); add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, 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); - add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, - dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL, + add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, + BT_LOGICAL, dl, GFC_STD_GNU, + gfc_check_isnan, gfc_simplify_isnan, NULL, x, BT_REAL, 0, REQUIRED); make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 4ae15783fc1..d1bf846c264 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -260,6 +260,9 @@ gfc_expr *gfc_simplify_long (gfc_expr *); gfc_expr *gfc_simplify_ifix (gfc_expr *); gfc_expr *gfc_simplify_idint (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_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_kind (gfc_expr *); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 18ce099ae77..5269e8f206e 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -2626,6 +2626,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_simplify_ishft (gfc_expr *e, gfc_expr *s) { gfc_expr *result; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0a0f7bb0a7f..e7368987dcc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-06-11 Francois-Xavier Coudert + + 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 * gcc.target/arm/neon-modes-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90 b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90 new file mode 100644 index 00000000000..eda9d31df19 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/nan_5.f90 b/gcc/testsuite/gfortran.dg/nan_5.f90 new file mode 100644 index 00000000000..64886bed0cf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nan_5.f90 @@ -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 -- 2.11.4.GIT