[gfortran,patch] Add ISNAN intrinsic

[FX Coudert <fxcoudert@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 354 bytes --]

This patch adds an ISNAN intrinsic as a GNU extension, since others  
compilers have it (ifort, g95, sunf95, sgi) and some code relies on  
it (http://www.libatoms.org/). The patch is simple, comes with a  
testcase and documentation written by Tobias Burnus (slightly  
modified by me).

Regtested on x86_64-linux, OK to commit?
FX


:ADDPATCH fortran:

[-- Attachment #2: isnan.ChangeLog --]
[-- Type: application/octet-stream, Size: 618 bytes --]

2007-08-04  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  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/32979
	* gfortran.dg/isnan_1.f90: New test.


[-- Attachment #3: isnan.diff --]
[-- Type: application/octet-stream, Size: 5375 bytes --]

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 127211)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -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);
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h	(revision 127211)
+++ gcc/fortran/intrinsic.h	(working copy)
@@ -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 *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 127211)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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,
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 127211)
+++ gcc/fortran/check.c	(working copy)
@@ -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)
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 127211)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -2765,6 +2765,18 @@ gfc_conv_intrinsic_ichar (gfc_se * se, g
 }
 
 
+/* 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_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;
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi	(revision 127211)
+++ gcc/fortran/intrinsic.texi	(working copy)
@@ -154,6 +154,7 @@ Some basic guidelines for editing this d
 * @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{INTEGE
 
 
 
+@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
Index: gcc/testsuite/gfortran.dg/isnan_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/isnan_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/isnan_1.f90	(revision 0)
@@ -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