[Bug fortran/32979] Implement vendor-specific ISNAN() intrinsic function

["fxcoudert at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

------- Comment #5 from fxcoudert at gcc dot gnu dot org  2007-08-03 22:07 -------
I'd go for implementing isnan as an extension, and only isnan. (until we get
the IEEE module). The following patch does just that:

Index: intrinsic.c
===================================================================
--- intrinsic.c (revision 127184)
+++ 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: intrinsic.h
===================================================================
--- intrinsic.h (revision 127184)
+++ 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: gfortran.h
===================================================================
--- gfortran.h  (revision 127184)
+++ 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: check.c
===================================================================
--- check.c     (revision 127184)
+++ 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: trans-intrinsic.c
===================================================================
--- trans-intrinsic.c   (revision 127185)
+++ 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
@@ -3965,6 +3977,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;


-- 

fxcoudert at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |fxcoudert at gcc dot gnu dot
                   |dot org                     |org
             Status|NEW                         |ASSIGNED
   Last reconfirmed|2007-08-03 22:06:10         |2007-08-03 22:07:47
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=32979