diff options
Diffstat (limited to 'gcc/fortran/trans-expr.cc')
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 30 |
1 files changed, 22 insertions, 8 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index d965539..62dd38d 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6925,10 +6925,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { /* Pass a NULL pointer for an absent arg. */ parmse.expr = null_pointer_node; + + /* Is it an absent character dummy? */ + bool absent_char = false; gfc_dummy_arg * const dummy_arg = arg->associated_dummy; - if (dummy_arg - && gfc_dummy_arg_get_typespec (*dummy_arg).type - == BT_CHARACTER) + + /* Fall back to inferred type only if no formal. */ + if (fsym) + absent_char = (fsym->ts.type == BT_CHARACTER); + else if (dummy_arg) + absent_char = (gfc_dummy_arg_get_typespec (*dummy_arg).type + == BT_CHARACTER); + if (absent_char) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } @@ -6954,9 +6962,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, || !CLASS_DATA (fsym)->attr.allocatable)); gfc_init_se (&parmse, NULL); parmse.expr = null_pointer_node; - if (arg->associated_dummy - && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type - == BT_CHARACTER) + if (fsym->ts.type == BT_CHARACTER) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } else if (fsym && fsym->ts.type == BT_CLASS @@ -7994,7 +8000,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_add_expr_to_block (&se->post, local_tmp); } - if (!finalized && !e->must_finalize) + /* Items of array expressions passed to a polymorphic formal arguments + create their own clean up, so prevent double free. */ + if (!finalized && !e->must_finalize + && !(e->expr_type == EXPR_ARRAY && fsym + && fsym->ts.type == BT_CLASS)) { bool scalar_res_outside_loop; scalar_res_outside_loop = e->expr_type == EXPR_FUNCTION @@ -8401,6 +8411,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, byref = (comp && (comp->attr.dimension || (comp->ts.type == BT_CHARACTER && !sym->attr.is_bind_c))) || (!comp && gfc_return_by_reference (sym)); + if (byref) { if (se->direct_byref) @@ -8585,6 +8596,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (ts.type == BT_CHARACTER) vec_safe_push (retargs, len); } + gfc_free_interface_mapping (&mapping); /* We need to glom RETARGS + ARGLIST + STRINGARGS + APPEND_ARGS. */ @@ -8769,10 +8781,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Transformational functions of derived types with allocatable components must have the result allocatable components copied when the - argument is actually given. */ + argument is actually given. This is unnecessry for REDUCE because the + wrapper for the OPERATION function takes care of this. */ arg = expr->value.function.actual; if (result && arg && expr->rank && isym && isym->transformational + && isym->id != GFC_ISYM_REDUCE && arg->expr && arg->expr->ts.type == BT_DERIVED && arg->expr->ts.u.derived->attr.alloc_comp) |