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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5e4bc6b..6182424 100644 (file)
--- 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
 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 b615f73..e792773 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3304,6 +3304,16 @@ gfc_check_isatty (gfc_expr *unit)
 
 
 try
 
 
 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)
 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 329fae2..dd1647d 100644 (file)
--- 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_IOR,
   GFC_ISYM_IRAND,
   GFC_ISYM_ISATTY,

+  GFC_ISYM_ISNAN,

   GFC_ISYM_ISHFT,
   GFC_ISYM_ISHFTC,
   GFC_ISYM_ITIME,
   GFC_ISYM_ISHFT,
   GFC_ISYM_ISHFTC,
   GFC_ISYM_ITIME,

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 11f47b5..e175dd6 100644 (file)
--- 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);
 
 
   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);
   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 4d6b7a7..c8548d1 100644 (file)
--- 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_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 *);
 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 7cb746a..8b9f9c2 100644 (file)
--- 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{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
 * @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
 @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 2dbbacc..dcdc3c7 100644 (file)
--- 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
 /* 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;
 
       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;
     case GFC_ISYM_LSHIFT:
       gfc_conv_intrinsic_rlshift (se, expr, 0);
       break;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b5f183e..f32d54a 100644 (file)
--- 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>
 
 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 (file)
index 0000000..fc0a3d0
--- /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