Hi all!
Proposed patch to PRs 52351, 85868 Wrong array section bounds when
passing to an intent-in pointer dummy.
Patch tested only on x86_64-pc-linux-gnu.
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.
Thank you very much.
Best regards,
José Rui
2020-5-25 José Rui Faustino de Sousa
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.
2020-5-25 José Rui Faustino de Sousa
PR fortran/85868
* PR85868A.f90: New test.
2020-5-25 José Rui Faustino de Sousa
PR fortran/85868
* PR85868B.f90: New test.
2020-5-25 José Rui Faustino de Sousa
PR fortran/85868
* coarray_lib_comm_1.f90: Adjust match test for the newly generated
descriptor.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 434960c..ef20989 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;
@@ -7271,7 +7270,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
else if (info->ref->u.ar.type == AR_FULL || se->descriptor_only)
full = 1;
else if (se->direct_byref)
- full = 0;
+ 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 (>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 (, 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 (, 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), );
- 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),
+
