From eb74e79b1b2bc2d2d244c8c84a7c7ef293686546 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 10 May 2009 07:23:30 +0000 Subject: re PR fortran/38863 (WHERE with multiple elemental defined assignments gives wrong answer) 2009-05-10 Paul Thomas PR fortran/38863 * trans-expr.c (gfc_conv_operator_assign): Remove function. * trans.h : Remove prototype for gfc_conv_operator_assign. * trans-stmt.c (gfc_conv_elemental_dependencies): Initialize derivde types with intent(out). (gfc_trans_call): Add mask, count1 and invert arguments. Add code to use mask for WHERE assignments. (gfc_trans_forall_1): Use new arguments for gfc_trans_call. (gfc_trans_where_assign): The gfc_symbol argument is replaced by the corresponding code. If this has a resolved_sym, then gfc_trans_call is called. The call to gfc_conv_operator_assign is removed. (gfc_trans_where_2): Change the last argument in the call to gfc_trans_where_assign. * trans-stmt.h : Modify prototype for gfc_trans_call. * trans.c (gfc_trans_code): Use new args for gfc_trans_call. 2009-05-10 Paul Thomas PR fortran/38863 * gfortran.dg/dependency_24.f90: New test. * gfortran.dg/dependency_23.f90: Clean up module files. From-SVN: r147329 --- gcc/fortran/trans-expr.c | 42 ------------------------------------------ 1 file changed, 42 deletions(-) (limited to 'gcc/fortran/trans-expr.c') diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 280a192..14f64c9 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1529,48 +1529,6 @@ conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr) } -/* Translate the call for an elemental subroutine call used in an operator - assignment. This is a simplified version of gfc_conv_procedure_call. */ - -tree -gfc_conv_operator_assign (gfc_se *lse, gfc_se *rse, gfc_symbol *sym) -{ - tree args; - tree tmp; - gfc_se se; - stmtblock_t block; - - /* Only elemental subroutines with two arguments. */ - gcc_assert (sym->attr.elemental && sym->attr.subroutine); - gcc_assert (sym->formal->next->next == NULL); - - gfc_init_block (&block); - - gfc_add_block_to_block (&block, &lse->pre); - gfc_add_block_to_block (&block, &rse->pre); - - /* Build the argument list for the call, including hidden string lengths. */ - args = gfc_chainon_list (NULL_TREE, gfc_build_addr_expr (NULL_TREE, lse->expr)); - args = gfc_chainon_list (args, gfc_build_addr_expr (NULL_TREE, rse->expr)); - if (lse->string_length != NULL_TREE) - args = gfc_chainon_list (args, lse->string_length); - if (rse->string_length != NULL_TREE) - args = gfc_chainon_list (args, rse->string_length); - - /* Build the function call. */ - gfc_init_se (&se, NULL); - conv_function_val (&se, sym, NULL); - tmp = TREE_TYPE (TREE_TYPE (TREE_TYPE (se.expr))); - tmp = build_call_list (tmp, se.expr, args); - gfc_add_expr_to_block (&block, tmp); - - gfc_add_block_to_block (&block, &lse->post); - gfc_add_block_to_block (&block, &rse->post); - - return gfc_finish_block (&block); -} - - /* Initialize MAPPING. */ void -- cgit v1.1