re PR fortran/32979 (Implement vendor-specific ISNAN() intrinsic function)

        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.

Co-Authored-By: Tobias Burnus <burnus@gcc.gnu.org>

From-SVN: r127224

gcc/fortran/ChangeLog

+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

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)

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,

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);

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 *);

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

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;

gcc/testsuite/ChangeLog

+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>
 

gcc/testsuite/gfortran.dg/isnan_1.f90

+! 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