diff options
author | José Rui Faustino de Sousa <jrfsousa@gmail.com> | 2020-06-11 14:14:30 +0200 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2020-06-11 14:21:38 +0200 |
commit | 2ff0f48819c8a7ed5d7c03e2bfc02e5907e2ff1a (patch) | |
tree | 8611f3116771c0354cd998a6ccda002912d0475d /gcc/fortran | |
parent | be11812eef33786f77676327667bf3885c1f33e8 (diff) | |
download | gcc-2ff0f48819c8a7ed5d7c03e2bfc02e5907e2ff1a.zip gcc-2ff0f48819c8a7ed5d7c03e2bfc02e5907e2ff1a.tar.gz gcc-2ff0f48819c8a7ed5d7c03e2bfc02e5907e2ff1a.tar.bz2 |
Wrong array section bounds when passing to an intent-in pointer dummy.
Add code to allow for the creation a new descriptor for array
sections with the correct one based indexing.
Rework the generated descriptors indexing (hopefully) fixing the
wrong offsets generated.
gcc/fortran/ChangeLog:
2020-06-11 José Rui Faustino de Sousa <jrfsousa@gmail.com>
PR fortran/52351
PR fortran/85868
* trans-array.c (gfc_conv_expr_descriptor): Enable the
creation of a new descriptor with the correct one based
indexing for array sections. Rework array descriptor
indexing offset calculation.
gcc/testsuite/ChangeLog:
2020-06-11 José Rui Faustino de Sousa <jrfsousa@gmail.com>
PR fortran/52351
PR fortran/85868
* gfortran.dg/coarray_lib_comm_1.f90: Adjust match test for
the newly generated descriptor.
* gfortran.dg/PR85868A.f90: New test.
* gfortran.dg/PR85868B.f90: New test.
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/trans-array.c | 129 |
1 files changed, 26 insertions, 103 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 434960c..3eb0e53 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7201,7 +7201,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tree desc; stmtblock_t block; tree start; - tree offset; int full; bool subref_array_target = false; bool deferred_array_component = false; @@ -7272,6 +7271,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) full = 1; else if (se->direct_byref) full = 0; + else if (info->ref->u.ar.dimen == 0 && !info->ref->next) + full = 1; + else if (info->ref->u.ar.type == AR_SECTION && se->want_pointer) + full = 0; else full = gfc_full_array_ref_p (info->ref, NULL); @@ -7508,10 +7511,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tree from; tree to; tree base; - bool onebased = false, rank_remap; + tree offset; ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen; - rank_remap = ss->dimen < ndim; if (se->want_coarray) { @@ -7555,10 +7557,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp); } - /* If we have an array section or are assigning make sure that - the lower bound is 1. References to the full - array should otherwise keep the original bounds. */ - if ((!info->ref || info->ref->u.ar.type != AR_FULL) && !se->want_pointer) + /* If we have an array section, are assigning or passing an array + section argument make sure that the lower bound is 1. References + to the full array should otherwise keep the original bounds. */ + if (!info->ref || info->ref->u.ar.type != AR_FULL) for (dim = 0; dim < loop.dimen; dim++) if (!integer_onep (loop.from[dim])) { @@ -7622,8 +7624,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) if (tmp != NULL_TREE) gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); - offset = gfc_index_zero_node; - /* The following can be somewhat confusing. We have two descriptors, a new one and the original array. {parm, parmtype, dim} refer to the new one. @@ -7637,22 +7637,17 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tmp = gfc_conv_descriptor_dtype (parm); gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype)); - /* Set offset for assignments to pointer only to zero if it is not - the full array. */ - if ((se->direct_byref || se->use_offset) - && ((info->ref && info->ref->u.ar.type != AR_FULL) - || (expr->expr_type == EXPR_ARRAY && se->use_offset))) - base = gfc_index_zero_node; - else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) - base = gfc_evaluate_now (gfc_conv_array_offset (desc), &loop.pre); - else - base = NULL_TREE; + /* The 1st element in the section. */ + base = gfc_index_zero_node; + + /* The offset from the 1st element in the section. */ + offset = gfc_index_zero_node; for (n = 0; n < ndim; n++) { stride = gfc_conv_array_stride (desc, n); - /* Work out the offset. */ + /* Work out the 1st element in the section. */ if (info->ref && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT) { @@ -7672,13 +7667,14 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) start, tmp); tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp), tmp, stride); - offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp), - offset, tmp); + base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp), + base, tmp); if (info->ref && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT) { - /* For elemental dimensions, we only need the offset. */ + /* For elemental dimensions, we only need the 1st + element in the section. */ continue; } @@ -7698,7 +7694,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) from = loop.from[dim]; to = loop.to[dim]; - onebased = integer_onep (from); gfc_conv_descriptor_lbound_set (&loop.pre, parm, gfc_rank_cst[dim], from); @@ -7712,35 +7707,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_array_index_type, stride, info->stride[n]); - if ((se->direct_byref || se->use_offset) - && ((info->ref && info->ref->u.ar.type != AR_FULL) - || (expr->expr_type == EXPR_ARRAY && se->use_offset))) - { - base = fold_build2_loc (input_location, MINUS_EXPR, - TREE_TYPE (base), base, stride); - } - else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)) || se->use_offset) - { - bool toonebased; - tmp = gfc_conv_array_lbound (desc, n); - toonebased = integer_onep (tmp); - // lb(arr) - from (- start + 1) - tmp = fold_build2_loc (input_location, MINUS_EXPR, - TREE_TYPE (base), tmp, from); - if (onebased && toonebased) - { - tmp = fold_build2_loc (input_location, MINUS_EXPR, - TREE_TYPE (base), tmp, start); - tmp = fold_build2_loc (input_location, PLUS_EXPR, - TREE_TYPE (base), tmp, - gfc_index_one_node); - } - tmp = fold_build2_loc (input_location, MULT_EXPR, - TREE_TYPE (base), tmp, - gfc_conv_array_stride (desc, n)); - base = fold_build2_loc (input_location, PLUS_EXPR, - TREE_TYPE (base), tmp, base); - } + tmp = fold_build2_loc (input_location, MULT_EXPR, + TREE_TYPE (offset), stride, from); + offset = fold_build2_loc (input_location, MINUS_EXPR, + TREE_TYPE (offset), offset, tmp); /* Store the new stride. */ gfc_conv_descriptor_stride_set (&loop.pre, parm, @@ -7763,58 +7733,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_index_zero_node); else /* Point the data pointer at the 1st element in the section. */ - gfc_get_dataptr_offset (&loop.pre, parm, desc, offset, + gfc_get_dataptr_offset (&loop.pre, parm, desc, base, subref_array_target, expr); - /* Force the offset to be -1, when the lower bound of the highest - dimension is one and the symbol is present and is not a - pointer/allocatable or associated. */ - if (((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) - && !se->data_not_needed) - || (se->use_offset && base != NULL_TREE)) - { - /* Set the offset depending on base. */ - tmp = rank_remap && !se->direct_byref ? - fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, base, - offset) - : base; - gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp); - } - else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) - && !se->data_not_needed - && (!rank_remap || se->use_offset)) - { - gfc_conv_descriptor_offset_set (&loop.pre, parm, - gfc_conv_descriptor_offset_get (desc)); - } - else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) - && !se->data_not_needed - && gfc_expr_attr (expr).select_rank_temporary) - { - gfc_conv_descriptor_offset_set (&loop.pre, parm, gfc_index_zero_node); - } - else if (onebased && (!rank_remap || se->use_offset) - && expr->symtree - && !(expr->symtree->n.sym && expr->symtree->n.sym->ts.type == BT_CLASS - && !CLASS_DATA (expr->symtree->n.sym)->attr.class_pointer) - && !expr->symtree->n.sym->attr.allocatable - && !expr->symtree->n.sym->attr.pointer - && !expr->symtree->n.sym->attr.host_assoc - && !expr->symtree->n.sym->attr.use_assoc) - { - /* Set the offset to -1. */ - mpz_t minus_one; - mpz_init_set_si (minus_one, -1); - tmp = gfc_conv_mpz_to_tree (minus_one, gfc_index_integer_kind); - gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp); - } - else - { - /* Only the callee knows what the correct offset it, so just set - it to zero here. */ - gfc_conv_descriptor_offset_set (&loop.pre, parm, gfc_index_zero_node); - } + gfc_conv_descriptor_offset_set (&loop.pre, parm, offset); + desc = parm; } |