From: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
Date: Fri, 14 May 2004 15:32:01 +0000 (+0200)
Subject: re PR fortran/15206 (RRSPACING intrinsics returns wrong result for 0.0)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4f9c6b6e187417a15ac89f7e76019f27fd637076;p=gcc.git

re PR fortran/15206 (RRSPACING intrinsics returns wrong result for 0.0)

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

From-SVN: r81848
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bae4efda1b2..605a5726b05 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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.
+
 2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* match.c (gfc_match): Eliminate dead code.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index ef7cd84acff..96eb306adc1 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2398,23 +2398,28 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
    se->expr = tmp;
 }
 
-/* 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);
-    }
-    t = bias + BITS_OF_FRACTION_OF;
-    res = (t << BITS_OF_FRACTION_OF) | frac;
+/* Generate code for RRSPACING (X) intrinsic function. We generate:
+
+    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;
 */
 
 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;
@@ -2438,6 +2443,10 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
    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;
 }