diff options
author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-05 10:18:38 +0000 |
---|---|---|
committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-05 10:18:38 +0000 |
commit | 4e549567c4c8d21e6551068f7cae378c78d8fd44 (patch) | |
tree | 8fbc4df09bb7056308d0cdaf08f97a757f42143a | |
parent | 3a943084c6493b7415990ef0fe56edcb65d397e6 (diff) | |
download | gcc-4e549567c4c8d21e6551068f7cae378c78d8fd44.tar.gz |
PR fortran/32979
* intrinsic.h (gfc_check_isnan): Add prototype.
* gfortran.h (gfc_isym_id): Add GFC_ISYM_ISNAN.
* intrinsic.c (add_functions): Add ISNAN intrinsic.
* check.c (gfc_check_isnan): New function.
* trans-intrinsic.c (gfc_conv_intrinsic_isnan): New function.
(gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_isnan
to translate ISNAN.
* intrinsic.texi: Document ISNAN.
* gfortran.dg/isnan_1.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127224 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
-rw-r--r-- | gcc/fortran/check.c | 10 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 6 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.h | 1 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.texi | 43 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 16 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/isnan_1.f90 | 18 |
9 files changed, 113 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5e4bc6b9058..61824241187 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2007-08-05 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + Tobias Burnus <burnus@gcc.gnu.org> + + PR fortran/32979 + * intrinsic.h (gfc_check_isnan): Add prototype. + * gfortran.h (gfc_isym_id): Add GFC_ISYM_ISNAN. + * intrinsic.c (add_functions): Add ISNAN intrinsic. + * check.c (gfc_check_isnan): New function. + * trans-intrinsic.c (gfc_conv_intrinsic_isnan): New function. + (gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_isnan + to translate ISNAN. + * intrinsic.texi: Document ISNAN. + 2007-08-04 Paul Thomas <pault@gcc.gnu.org> PR fortran/31214 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index b615f7334cb..e792773f928 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3304,6 +3304,16 @@ gfc_check_isatty (gfc_expr *unit) try +gfc_check_isnan (gfc_expr *x) +{ + if (type_check (x, 0, BT_REAL) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_perror (gfc_expr *string) { if (type_check (string, 0, BT_CHARACTER) == FAILURE) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 329fae2103f..dd1647dcfbf 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -422,6 +422,7 @@ enum gfc_isym_id GFC_ISYM_IOR, GFC_ISYM_IRAND, GFC_ISYM_ISATTY, + GFC_ISYM_ISNAN, GFC_ISYM_ISHFT, GFC_ISYM_ISHFTC, GFC_ISYM_ITIME, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 11f47b5ce3b..e175dd678b9 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1617,6 +1617,12 @@ add_functions (void) make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU); + add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, + dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL, + x, BT_REAL, 0, REQUIRED); + + make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU); + add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU, gfc_check_ishft, NULL, gfc_resolve_rshift, i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 4d6b7a76a18..c8548d14bdf 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -78,6 +78,7 @@ try gfc_check_intconv (gfc_expr *); try gfc_check_ior (gfc_expr *, gfc_expr *); try gfc_check_irand (gfc_expr *); try gfc_check_isatty (gfc_expr *); +try gfc_check_isnan (gfc_expr *); try gfc_check_ishft (gfc_expr *, gfc_expr *); try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_kill (gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 7cb746ab1d5..8b9f9c2cb01 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -154,6 +154,7 @@ Some basic guidelines for editing this document: * @code{ISATTY}: ISATTY, Whether a unit is a terminal device * @code{ISHFT}: ISHFT, Shift bits * @code{ISHFTC}: ISHFTC, Shift bits circularly +* @code{ISNAN}: ISNAN, Tests for a NaN * @code{ITIME}: ITIME, Current local time (hour/minutes/seconds) * @code{KILL}: KILL, Send a signal to a process * @code{KIND}: KIND, Kind of an entity @@ -5927,6 +5928,48 @@ The return value is of type @code{INTEGER(*)} and of the same kind as +@node ISNAN +@section @code{ISNAN} --- Test for a NaN +@fnindex ISNAN +@cindex IEEE, ISNAN + +@table @asis +@item @emph{Description}: +@code{ISNAN} tests whether a floating-point value is an IEEE +Not-a-Number (NaN). +@item @emph{Standard}: +GNU extension + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{ISNAN(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab Variable of the type @code{REAL}. + +@end multitable + +@item @emph{Return value}: +Returns a default-kind @code{LOGICAL}. The returned value is @code{TRUE} +if @var{X} is a NaN and @code{FALSE} otherwise. + +@item @emph{Example}: +@smallexample +program test_nan + implicit none + real :: x + x = -1.0 + x = sqrt(x) + if (isnan(x)) stop '"x" is a NaN' +end program test_nan +@end smallexample +@end table + + + @node ITIME @section @code{ITIME} --- Get current local time subroutine (hour/minutes/seconds) @fnindex ITIME diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 2dbbacce221..dcdc3c7be41 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2765,6 +2765,18 @@ gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr) } +/* Intrinsic ISNAN calls __builtin_isnan. */ + +static void +gfc_conv_intrinsic_isnan (gfc_se * se, gfc_expr * expr) +{ + tree arg; + + gfc_conv_intrinsic_function_args (se, expr, &arg, 1); + se->expr = build_call_expr (built_in_decls[BUILT_IN_ISNAN], 1, arg); + se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr); +} + /* MERGE (tsource, fsource, mask) = mask ? tsource : fsource. */ static void @@ -3987,6 +3999,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR); break; + case GFC_ISYM_ISNAN: + gfc_conv_intrinsic_isnan (se, expr); + break; + case GFC_ISYM_LSHIFT: gfc_conv_intrinsic_rlshift (se, expr, 0); break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b5f183e68c7..f32d54a7f5f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-08-05 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/32979 + * gfortran.dg/isnan_1.f90: New test. + 2007-08-05 Vladimir Yanovsky <yanov@il.ibm.com> Revital Eres <eres@il.ibm.com> diff --git a/gcc/testsuite/gfortran.dg/isnan_1.f90 b/gcc/testsuite/gfortran.dg/isnan_1.f90 new file mode 100644 index 00000000000..fc0a3d0d873 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/isnan_1.f90 @@ -0,0 +1,18 @@ +! Test for the ISNAN intrinsic +! +! { dg-do run } + implicit none + real :: x + x = -1.0 + x = sqrt(x) + if (.not. isnan(x)) call abort + x = 0.0 + x = x / x + if (.not. isnan(x)) call abort + + x = 5.0 + if (isnan(x)) call abort + x = huge(x) + x = 2*x + if (isnan(x)) call abort +end |