[gfortran] Fix PR 19032

[Tobias Schlüter]

Thomas Koenig wrote:
>>I don't know if this works correctly in the case of reals, but I didn't change
>>its current functionality.
> 
> 
> Reals are also broken (see comment #4 for PR 19032).
> 

Updated patch below. This should fix both REALs and INTEGERs, and contains the
old patch which only dealt with INTEGERs. What it does is use FLOOR_MOD_EXPR
(FIX_FLOOR_EXPR) instead of TRUNC_MOD_EXPR (FIX_TRUNC_EXPR) in the case of
INTEGERs (REALs), and do away completely with the special clause which dealt
with MODULO before.

Bubblestrapped and tested, new testcase (essentially the one from the PR)
attached. Ok?

- Tobi

2004-12-20  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/19032
	* trans-intrinsic.c (gfc_conv_intrinsic_mod): Update comment
	in front of function to match the standard.  Correct handling
	of MODULO.

@@ -771,8 +781,8 @@ gfc_conv_intrinsic_cmplx (gfc_se * se, g
   se->expr = fold (build2 (COMPLEX_EXPR, type, real, imag));
 }

-/* Remainder function MOD(A, P) = A - INT(A / P) * P.
-   MODULO(A, P) = (A==0 .or. !(A>0 .xor. P>0))? MOD(A,P):MOD(A,P)+P.  */
+/* Remainder function MOD(A, P) = A - INT(A / P) * P
+                      MODULO(A, P) = A - FLOOR (A / P) * P  */
 /* TODO: MOD(x, 0)  */

 static void
@@ -798,7 +808,10 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc
     {
     case BT_INTEGER:
       /* Integer case is easy, we've got a builtin op.  */
-      se->expr = build2 (TRUNC_MOD_EXPR, type, arg, arg2);
+      if (modulo)
+       se->expr = build2 (FLOOR_MOD_EXPR, type, arg, arg2);
+      else
+       se->expr = build2 (TRUNC_MOD_EXPR, type, arg, arg2);
       break;

     case BT_REAL:
@@ -821,7 +834,10 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc
       test2 = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2);

       itype = gfc_get_int_type (expr->ts.kind);
-      tmp = build_fix_expr (&se->pre, tmp, itype, FIX_TRUNC_EXPR);
+      if (modulo)
+       tmp = build_fix_expr (&se->pre, tmp, itype, FIX_FLOOR_EXPR);
+      else
+       tmp = build_fix_expr (&se->pre, tmp, itype, FIX_TRUNC_EXPR);
       tmp = convert (type, tmp);
       tmp = build3 (COND_EXPR, type, test2, tmp, arg);
       tmp = build2 (MULT_EXPR, type, tmp, arg2);
@@ -832,22 +848,6 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc
     default:
       gcc_unreachable ();
     }
-
-  if (modulo)
-    {
-     zero = gfc_build_const (type, integer_zero_node);
-     /* Build !(A > 0 .xor. P > 0).  */
-     test = build2 (GT_EXPR, boolean_type_node, arg, zero);
-     test2 = build2 (GT_EXPR, boolean_type_node, arg2, zero);
-     test = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2);
-     test = build1 (TRUTH_NOT_EXPR, boolean_type_node, test);
-     /* Build (A == 0) .or. !(A > 0 .xor. P > 0).  */
-     test2 = build2 (EQ_EXPR, boolean_type_node, arg, zero);
-     test = build2 (TRUTH_OR_EXPR, boolean_type_node, test, test2);
-
-     se->expr = build3 (COND_EXPR, type, test, se->expr,
-                       build2 (PLUS_EXPR, type, se->expr, arg2));
-    }
 }

 /* Positive difference DIM (x, y) = ((x - y) < 0) ? 0 : x - y.  */

-------------- next part --------------
An embedded and charset-unspecified text was scrubbed...
Name: intrinsic_modulo_1.f90
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20041220/9a4b6c91/attachment.f90>