diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2010-02-13 12:42:39 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2010-02-13 12:42:39 +0000 |
| commit | 17555e7e367ff3b334e7eae368e5c3a9b4485579 (patch) | |
| tree | bd94b6f2656e80971481f28a74ece91687210157 /gcc/fortran/trans-array.c | |
| parent | 97d22c8a230e4ce8cf557f6a84f529a473d10b2d (diff) | |
| download | gcc-17555e7e367ff3b334e7eae368e5c3a9b4485579.zip gcc-17555e7e367ff3b334e7eae368e5c3a9b4485579.tar.gz gcc-17555e7e367ff3b334e7eae368e5c3a9b4485579.tar.bz2 | |
re PR fortran/41113 (spurious _gfortran_internal_pack)
2010-02-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41113
PR fortran/41117
* trans-array.c (gfc_conv_array_parameter): Use
gfc_full_array_ref_p to detect full and contiguous variable
arrays. Full array components and contiguous arrays do not need
internal_pack and internal_unpack.
2010-02-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41113
PR fortran/41117
* gfortran.dg/internal_pack_6.f90: New test.
From-SVN: r156749
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 41 |
1 files changed, 36 insertions, 5 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d512da4..ae39aed 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5468,17 +5468,27 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, tree tmp = NULL_TREE; tree stmt; tree parent = DECL_CONTEXT (current_function_decl); - bool full_array_var, this_array_result; + bool full_array_var; + bool this_array_result; + bool contiguous; gfc_symbol *sym; stmtblock_t block; + gfc_ref *ref; + + for (ref = expr->ref; ref; ref = ref->next) + if (ref->next == NULL) + break; + + full_array_var = false; + contiguous = false; + + if (expr->expr_type == EXPR_VARIABLE && ref) + full_array_var = gfc_full_array_ref_p (ref, &contiguous); - full_array_var = (expr->expr_type == EXPR_VARIABLE - && expr->ref->type == REF_ARRAY - && expr->ref->u.ar.type == AR_FULL); sym = full_array_var ? expr->symtree->n.sym : NULL; /* The symbol should have an array specification. */ - gcc_assert (!sym || sym->as); + gcc_assert (!sym || sym->as || ref->u.ar.as); if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER) { @@ -5501,6 +5511,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, if (sym->ts.type == BT_CHARACTER) se->string_length = sym->ts.u.cl->backend_decl; + + if (sym->ts.type == BT_DERIVED && !sym->as) + { + gfc_conv_expr_descriptor (se, expr, ss); + se->expr = gfc_conv_array_data (se->expr); + return; + } + if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE && !sym->attr.allocatable) { @@ -5514,6 +5532,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, array_parameter_size (tmp, expr, size); return; } + if (sym->attr.allocatable) { if (sym->attr.dummy || sym->attr.result) @@ -5528,6 +5547,18 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, } } + if (contiguous && g77 && !this_array_result + && !expr->symtree->n.sym->attr.dummy) + { + gfc_conv_expr_descriptor (se, expr, ss); + if (expr->ts.type == BT_CHARACTER) + se->string_length = expr->ts.u.cl->backend_decl; + if (size) + array_parameter_size (se->expr, expr, size); + se->expr = gfc_conv_array_data (se->expr); + return; + } + if (this_array_result) { /* Result of the enclosing function. */ |