2006-11-05 Francois-Xavier Coudert <fxcoudert@gcc.gnu,org>

	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24518
	* trans-intrinsic.c (gfc_conv_intrinsic_mod): Use built_in fmod
	for both MOD and MODULO, if it is available.

	PR fortran/29565
	* trans-expr.c (gfc_conv_aliased_arg): For an INTENT(OUT), save
	the declarations from the unused loops by merging the block
	scope for each; this ensures that the temporary is declared.

2006-11-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29565
	* gfortran.dg/gfortran.dg/aliasing_dummy_3.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118492 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6cc6b20..e22e33f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-11-05  Francois-Xavier Coudert  <fxcoudert@gcc.gnu,org>
+           Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/24518
+       * trans-intrinsic.c (gfc_conv_intrinsic_mod): Use built_in fmod
+       for both MOD and MODULO, if it is available.
+
+       PR fortran/29565
+       * trans-expr.c (gfc_conv_aliased_arg): For an INTENT(OUT), save
+       the declarations from the unused loops by merging the block
+       scope for each; this ensures that the temporary is declared.
+
 2006-11-04  Brooks Moses  <brooks.moses@codesourcery.com>
 
        * error.c (show_locus): Add trailing colon in error messages.

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 263d6ee..52c0b5f 100644 (file)
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -896,6 +896,13 @@ gfc_init_builtin_functions (void)
                      BUILT_IN_COPYSIGN, "copysign", true);
   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], 
                      BUILT_IN_COPYSIGNF, "copysignf", true);
+ 
+  gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], 
+                     BUILT_IN_FMODL, "fmodl", true);
+  gfc_define_builtin ("__builtin_fmod", mfunc_double[1], 
+                     BUILT_IN_FMOD, "fmod", true);
+  gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], 
+                     BUILT_IN_FMODF, "fmodf", true);
 
   /* These are used to implement the ** operator.  */
   gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f4fcea5..9e44bfd 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1715,9 +1715,14 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
     }
   else
     {
-      /* Make sure that the temporary declaration survives.  */
-      tmp = gfc_finish_block (&body);
-      gfc_add_expr_to_block (&loop.pre, tmp);
+      /* Make sure that the temporary declaration survives by merging
+       all the loop declarations into the current context.  */
+      for (n = 0; n < loop.dimen; n++)
+       {
+         gfc_merge_block_scope (&body);
+         body = loop.code[loop.order[n]];
+       }
+      gfc_merge_block_scope (&body);
     }
 
   /* Add the post block after the second loop, so that any

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d031878..5389c0b 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -976,14 +976,15 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
   int n, ikind;
 
   arg = gfc_conv_intrinsic_function_args (se, expr);
-  arg2 = TREE_VALUE (TREE_CHAIN (arg));
-  arg = TREE_VALUE (arg);
-  type = TREE_TYPE (arg);
 
   switch (expr->ts.type)
     {
     case BT_INTEGER:
       /* Integer case is easy, we've got a builtin op.  */
+      arg2 = TREE_VALUE (TREE_CHAIN (arg));
+      arg = TREE_VALUE (arg);
+      type = TREE_TYPE (arg);
+
       if (modulo)
        se->expr = build2 (FLOOR_MOD_EXPR, type, arg, arg2);
       else
@@ -991,11 +992,69 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
       break;
 
     case BT_REAL:
-      /* Real values we have to do the hard way.  */
+      n = END_BUILTINS;
+      /* Check if we have a builtin fmod.  */
+      switch (expr->ts.kind)
+       {
+       case 4:
+         n = BUILT_IN_FMODF;
+         break;
+
+       case 8:
+         n = BUILT_IN_FMOD;
+         break;
+
+       case 10:
+       case 16:
+         n = BUILT_IN_FMODL;
+         break;
+
+       default:
+         break;
+       }
+
+      /* Use it if it exists.  */
+      if (n != END_BUILTINS)
+       {
+         tmp = built_in_decls[n];
+         se->expr = build_function_call_expr (tmp, arg);
+         if (modulo == 0)
+           return;
+       }
+
+      arg2 = TREE_VALUE (TREE_CHAIN (arg));
+      arg = TREE_VALUE (arg);
+      type = TREE_TYPE (arg);
+
       arg = gfc_evaluate_now (arg, &se->pre);
       arg2 = gfc_evaluate_now (arg2, &se->pre);
 
+      /* Definition:
+        modulo = arg - floor (arg/arg2) * arg2, so
+               = test ? fmod (arg, arg2) : fmod (arg, arg2) + arg2, 
+        where
+         test  = (fmod (arg, arg2) != 0) && ((arg < 0) xor (arg2 < 0))
+        thereby avoiding another division and retaining the accuracy
+        of the builtin function.  */
+      if (n != END_BUILTINS && modulo)
+       {
+         tree zero = gfc_build_const (type, integer_zero_node);
+         tmp = gfc_evaluate_now (se->expr, &se->pre);
+         test = build2 (LT_EXPR, boolean_type_node, arg, zero);
+         test2 = build2 (LT_EXPR, boolean_type_node, arg2, zero);
+         test2 = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2);
+         test = build2 (NE_EXPR, boolean_type_node, tmp, zero);
+         test = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2);
+         test = gfc_evaluate_now (test, &se->pre);
+         se->expr = build3 (COND_EXPR, type, test,
+                            build2 (PLUS_EXPR, type, tmp, arg2), tmp);
+         return;
+       }
+
+      /* If we do not have a built_in fmod, the calculation is going to
+        have to be done longhand.  */
       tmp = build2 (RDIV_EXPR, type, arg, arg2);
+
       /* Test if the value is too large to handle sensibly.  */
       gfc_set_model_kind (expr->ts.kind);
       mpfr_init (huge);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7bce686..8d4b189 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-11-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/29565
+       * gfortran.dg/gfortran.dg/aliasing_dummy_3.f90: New test.
+
 2006-11-04  Brooks Moses  <brooks.moses@codesourcery.com>
 
        * lib/gfortran-dg.exp (gfortran-dg-test): Adjust pattern

diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_3.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_3.f90
new file mode 100644 (file)
index 0000000..f090280
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! This tests the fix for PR29565, which failed in the gimplifier
+! with the third call to has_read_key because this lost the first
+! temporary array declaration from the current context.
+!
+! Contributed by William Mitchell  <william.mitchell@nist.gov>
+!
+  type element_t
+    integer :: gid
+  end type element_t
+
+  type(element_t) :: element(1)
+   call hash_read_key(element%gid)
+   call hash_read_key(element%gid)
+   call hash_read_key(element%gid)
+contains
+  subroutine hash_read_key(key)
+    integer, intent(out) :: key(1)
+  end subroutine hash_read_key
+end