[gfortran] PR15206 RRSPACING wrong for zero

[Tobias Schlüter]

This patch fixes the RRSPACING intrinsic. It didn't return the correct 
result for a zero argument. I don't really understand how the original 
code worked, but I verified that RRSPACING(x) == x/SPACING(x) for a wide 
range of arguments. I used the condition (expn == 0 && frac == 0) to 
check for a zero argument, if this is not the correct check, please 
correct this.

Bootstrapped and regtested on i686-pc-linux.

- Tobi


2004-05-08  Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/15206
	* trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to
	handle zero correctly.

Index: trans-intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/trans-intrinsic.c,v
retrieving revision 1.1.2.30
diff -u -p -r1.1.2.30 trans-intrinsic.c
--- trans-intrinsic.c	24 Apr 2004 12:19:27 -0000	1.1.2.30
+++ trans-intrinsic.c	8 May 2004 16:19:17 -0000
@@ -2399,22 +2400,27 @@ gfc_conv_intrinsic_spacing (gfc_se * se,
  }

  /* Generate code for RRSPACING (X) intrinsic function. We generate: 

-    sedigits = edigits + 1;
-    if (expn == 0)
-    {
-      t1 = leadzero (frac);
-      frac = frac << (t1 + sedigits);
-      frac = frac >> (sedigits);
+    if (expn == 0 && frac == 0)
+       res = 0;
+    else
+    {
+       sedigits = edigits + 1;
+       if (expn == 0)
+       {
+         t1 = leadzero (frac);
+         frac = frac << (t1 + sedigits);
+         frac = frac >> (sedigits);
+       }
+       t = bias + BITS_OF_FRACTION_OF;
+       res = (t << BITS_OF_FRACTION_OF) | frac;
      }
-    t = bias + BITS_OF_FRACTION_OF;
-    res = (t << BITS_OF_FRACTION_OF) | frac;
  */

  static void
  gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
  {
     tree masktype;
-   tree tmp, t1, t2, cond;
+   tree tmp, t1, t2, cond, cond2;
     tree one, zero;
     tree fdigits, fraction;
     real_compnt_info rcs;
@@ -2437,6 +2443,10 @@ gfc_conv_intrinsic_rrspacing (gfc_se * s
     tmp = build (PLUS_EXPR, masktype, rcs.bias, fdigits);
     tmp = build (LSHIFT_EXPR, masktype, tmp, fdigits);
     tmp = build (BIT_IOR_EXPR, masktype, tmp, fraction);
+
+   cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero);
+   cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
+   tmp = build (COND_EXPR, masktype, cond, integer_zero_node, tmp);

     tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
     se->expr = tmp;