From: Paul Thomas Date: Sun, 5 Nov 2006 06:27:48 +0000 (+0000) Subject: 2006-11-05 Francois-Xavier Coudert X-Git-Tag: releases/gcc-4.3.0~8627 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=58b6e04789a04563418234e753835ee6248bf4d8;p=thirdparty%2Fgcc.git 2006-11-05 Francois-Xavier Coudert Paul Thomas 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 PR fortran/29565 * gfortran.dg/gfortran.dg/aliasing_dummy_3.f90: New test. From-SVN: r118492 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6cc6b20301b6..e22e33fa4b1d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2006-11-05 Francois-Xavier Coudert + Paul Thomas + + 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 * 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 263d6eefe39a..52c0b5f5adbb 100644 --- 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 f4fcea5d35b6..9e44bfd34352 100644 --- 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 d0318789a871..5389c0b3708e 100644 --- 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 7bce686264e5..8d4b189f87a1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-11-05 Paul Thomas + + PR fortran/29565 + * gfortran.dg/gfortran.dg/aliasing_dummy_3.f90: New test. + 2006-11-04 Brooks Moses * 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 index 000000000000..f09028062d10 --- /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 +! + 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