diff options
| author | pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-05-08 12:45:31 +0000 |
|---|---|---|
| committer | pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-05-08 12:45:31 +0000 |
| commit | eeba931ec40a2b7a9ea41a44e9706e966f95a3ae (patch) | |
| tree | 2126533d0ca55b44dcb679213e46878622b70f8d /gcc/fortran/trans-array.c | |
| parent | fef98e29b98ff9f8eb89d4f08b6b6a14c1dd5da1 (diff) | |
| download | gcc-eeba931ec40a2b7a9ea41a44e9706e966f95a3ae.tar.gz | |
2007-05-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31692
* trans-array.c (gfc_conv_array_parameter): Convert full array
references to the result of the procedure enclusing the call.
2007-05-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31692
* gfortran.dg/actual_array_result_1.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@124546 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 38 |
1 files changed, 33 insertions, 5 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 92fd67cccf5..4997673904f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4748,14 +4748,25 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77) tree desc; tree tmp; tree stmt; + tree parent = DECL_CONTEXT (current_function_decl); + bool full_array_var, this_array_result; gfc_symbol *sym; stmtblock_t block; + full_array_var = (expr->expr_type == EXPR_VARIABLE + && expr->ref->u.ar.type == AR_FULL); + sym = full_array_var ? expr->symtree->n.sym : NULL; + + /* Is this the result of the enclosing procedure? */ + this_array_result = (full_array_var && sym->attr.flavor == FL_PROCEDURE); + if (this_array_result + && (sym->backend_decl != current_function_decl) + && (sym->backend_decl != parent)) + this_array_result = false; + /* Passing address of the array if it is not pointer or assumed-shape. */ - if (expr->expr_type == EXPR_VARIABLE - && expr->ref->u.ar.type == AR_FULL && g77) + if (full_array_var && g77 && !this_array_result) { - sym = expr->symtree->n.sym; tmp = gfc_get_symbol_decl (sym); if (sym->ts.type == BT_CHARACTER) @@ -4784,8 +4795,25 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77) } } - se->want_pointer = 1; - gfc_conv_expr_descriptor (se, expr, ss); + if (this_array_result) + { + /* Result of the enclosing function. */ + gfc_conv_expr_descriptor (se, expr, ss); + se->expr = build_fold_addr_expr (se->expr); + + if (g77 && TREE_TYPE (TREE_TYPE (se->expr)) != NULL_TREE + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr)))) + se->expr = gfc_conv_array_data (build_fold_indirect_ref (se->expr)); + + return; + } + else + { + /* Every other type of array. */ + se->want_pointer = 1; + gfc_conv_expr_descriptor (se, expr, ss); + } + /* Deallocate the allocatable components of structures that are not variable. */ |