diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 44 |
1 files changed, 41 insertions, 3 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b5091a9..4a70e73 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2294,8 +2294,8 @@ gfc_apply_interface_mapping (gfc_interface_mapping * mapping, an actual argument derived type array is copied and then returned after the function call. */ void -gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, - int g77, sym_intent intent) +gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, + sym_intent intent, bool formal_ptr) { gfc_se lse; gfc_se rse; @@ -2308,6 +2308,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, tree tmp_index; tree tmp; tree base_type; + tree size; stmtblock_t body; int n; @@ -2501,6 +2502,42 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, if (expr->ts.type == BT_CHARACTER) parmse->string_length = expr->ts.u.cl->backend_decl; + /* Determine the offset for pointer formal arguments and set the + lbounds to one. */ + if (formal_ptr) + { + size = gfc_index_one_node; + offset = gfc_index_zero_node; + for (n = 0; n < info->dimen; n++) + { + tmp = gfc_conv_descriptor_ubound_get (parmse->expr, + gfc_rank_cst[n]); + tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + gfc_conv_descriptor_ubound_set (&parmse->pre, + parmse->expr, + gfc_rank_cst[n], + tmp); + gfc_conv_descriptor_lbound_set (&parmse->pre, + parmse->expr, + gfc_rank_cst[n], + gfc_index_one_node); + size = gfc_evaluate_now (size, &parmse->pre); + offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, + offset, size); + offset = gfc_evaluate_now (offset, &parmse->pre); + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, + rse.loop->to[n], rse.loop->from[n]); + tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + size = fold_build2 (MULT_EXPR, gfc_array_index_type, + size, tmp); + } + + gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr, + offset); + } + /* We want either the address for the data or the address of the descriptor, depending on the mode of passing array arguments. */ if (g77) @@ -3005,7 +3042,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, is converted to a temporary, which is passed and then written back after the procedure call. */ gfc_conv_subref_array_arg (&parmse, e, f, - fsym ? fsym->attr.intent : INTENT_INOUT); + fsym ? fsym->attr.intent : INTENT_INOUT, + fsym && fsym->attr.pointer); else gfc_conv_array_parameter (&parmse, e, argss, f, fsym, sym->name, NULL); |