diff options
| author | Tobias Burnus <burnus@net-b.de> | 2018-10-16 20:37:08 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2018-10-16 20:37:08 +0200 |
| commit | c152593057a3315c3e11343efb2717d5fa8b5df0 (patch) | |
| tree | 494f41ed69baffeea88852147f7a3958480cd6ee /gcc/fortran/trans-stmt.c | |
| parent | 91ab2a1d6e137c2eaa6f8f5966b611bca700ef96 (diff) | |
| download | gcc-c152593057a3315c3e11343efb2717d5fa8b5df0.zip gcc-c152593057a3315c3e11343efb2717d5fa8b5df0.tar.gz gcc-c152593057a3315c3e11343efb2717d5fa8b5df0.tar.bz2 | |
Fix bounds with ALLOCATE with source-expr
PR fortran/67125
* trans-array.c (gfc_array_init_size, gfc_array_allocate):
Rename argument e3_is_array_constr to e3_has_nodescriptor
and update comments.
* trans-stmt.c (gfc_trans_allocate): Also fix lower bound
to 1 for nonalloc/nonpointer func results/vars besides
array constructors.
PR fortran/67125
* gfortran.dg/allocate_with_source_26.f90: New.
From-SVN: r265212
Diffstat (limited to 'gcc/fortran/trans-stmt.c')
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 16 |
1 files changed, 14 insertions, 2 deletions
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 130e67b..c778df0 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5801,6 +5801,7 @@ gfc_trans_allocate (gfc_code * code) tree nelems; bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray; bool needs_caf_sync, caf_refs_comp; + bool e3_has_nodescriptor = false; gfc_symtree *newsym = NULL; symbol_attribute caf_attr; gfc_actual_arglist *param_list; @@ -6236,6 +6237,17 @@ gfc_trans_allocate (gfc_code * code) } else e3rhs = gfc_copy_expr (code->expr3); + + // We need to propagate the bounds of the expr3 for source=/mold=; + // however, for nondescriptor arrays, we use internally a lower bound + // of zero instead of one, which needs to be corrected for the allocate obj + if (e3_is == E3_DESC) + { + symbol_attribute attr = gfc_expr_attr (code->expr3); + if (code->expr3->expr_type == EXPR_ARRAY || + (!attr.allocatable && !attr.pointer)) + e3_has_nodescriptor = true; + } } /* Loop over all objects to allocate. */ @@ -6319,12 +6331,12 @@ gfc_trans_allocate (gfc_code * code) } else tmp = expr3_esize; + if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen, label_finish, tmp, &nelems, e3rhs ? e3rhs : code->expr3, e3_is == E3_DESC ? expr3 : NULL_TREE, - code->expr3 != NULL && e3_is == E3_DESC - && code->expr3->expr_type == EXPR_ARRAY)) + e3_has_nodescriptor)) { /* A scalar or derived type. First compute the size to allocate. |