Hi all!
Proposed patch to PR95331 - Unlimited polymorphic arrays have wrong bounds.
Patch tested only on x86_64-pc-linux-gnu.
When iterating over a class array use the bounds provided by the
transformed descriptor (in sym->backend_decl) instead of the original
bounds of the array (in the descriptor passed in the class _data) which
are passed in se->expr.
The patch partially depends on the patch for PR52351 and PR85868, but
does not seems to break anything by itself.
Not sure if this is the best solution, but at least it identifies the
problem.
Thank you very much.
Best regards,
José Rui
2020-5-26 José Rui Faustino de Sousa
PR fortran/95331
* trans-array.c (gfc_conv_array_ref): For class array dummy arguments
use the transformed descriptor in sym->backend_decl instead of the
original descriptor.
2020-5-26 José Rui Faustino de Sousa
PR fortran/95331
* PR95331.f90: New test.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 434960c..f44a986 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3672,8 +3672,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
}
+ decl = se->expr;
+ if (IS_CLASS_ARRAY (sym) && sym->attr.dummy && ar->as->type != AS_DEFERRED)
+decl = sym->backend_decl;
+
cst_offset = offset = gfc_index_zero_node;
- add_to_offset (_offset, , gfc_conv_array_offset (se->expr));
+ add_to_offset (_offset, , gfc_conv_array_offset (decl));
/* Calculate the offsets from all the dimensions. Make sure to associate
the final offset so that we form a chain of loop invariant summands. */
@@ -3694,7 +3698,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
indexse.expr = save_expr (indexse.expr);
/* Lower bound. */
- tmp = gfc_conv_array_lbound (se->expr, n);
+ tmp = gfc_conv_array_lbound (decl, n);
if (sym->attr.temporary)
{
gfc_init_se (, se);
@@ -3718,7 +3722,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
arrays. */
if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
{
- tmp = gfc_conv_array_ubound (se->expr, n);
+ tmp = gfc_conv_array_ubound (decl, n);
if (sym->attr.temporary)
{
gfc_init_se (, se);
@@ -3741,7 +3745,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
/* Multiply the index by the stride. */
- stride = gfc_conv_array_stride (se->expr, n);
+ stride = gfc_conv_array_stride (decl, n);
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
indexse.expr, stride);
@@ -3756,6 +3760,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
/* A pointer array component can be detected from its field decl. Fix
the descriptor, mark the resulting variable decl and pass it to
build_array_ref. */
+ decl = NULL_TREE;
if (get_CFI_desc (sym, expr, , ar))
decl = build_fold_indirect_ref_loc (input_location, decl);
if (!expr->ts.deferred && !sym->attr.codimension
diff --git a/gcc/testsuite/gfortran.dg/PR95331.f90
b/gcc/testsuite/gfortran.dg/PR95331.f90
new file mode 100644
index 000..8024e79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR95331.f90
@@ -0,0 +1,163 @@
+! { dg-do run }
+!
+! PR fortran/95331
+!
+
+program main_p
+
+ implicit none
+
+ integer, parameter :: n = 10
+ integer, parameter :: m = 5
+
+ integer, parameter :: b = 3
+ integer, parameter :: t = n+b-1
+
+ integer, parameter :: l = 4
+ integer, parameter :: u = 7
+ integer, parameter :: s = 3
+ integer, parameter :: e = (u-l)/s+1
+
+ call test_f()
+ call test_s()
+ call test_p()
+ call test_a()
+ stop
+
+contains
+
+ subroutine test_f()
+integer :: x(n,n)
+integer :: y(b:t)
+integer :: i
+
+x = reshape([(i, i=1,n*n)], [n,n])
+y = x(:,m)
+call sub_s(x(:,m), y, n)
+call sub_s(y, x(:,m), n)
+return
+ end subroutine test_f
+
+ subroutine test_s()
+integer :: x(n,n)
+integer :: v(e)
+integer :: i
+
+x = reshape([(i, i=1,n*n)], [n,n])
+v = x(l:u:s,m)
+call sub_s(v, v, e)
+call sub_s(x(l:u:s,m), v, e)
+call sub_s(v, x(l:u:s,m), e)
+return
+ end subroutine test_s
+
+ subroutine test_p()
+integer, target :: x(n,n)
+integer, pointer :: p(:)
+integer :: v(e)
+integer :: i
+
+x = reshape([(i, i=1,n*n)], [n,n])
+v = x(l:u:s,m)
+p => x(:,m)
+call sub_s(p(l:u:s), v, e)
+p => x(l:u:s,m)
+call sub_s(p, v, e)
+p(l:) => x(l:u:s,m)
+call sub_s(p, v, e)
+p(l:l+e-1) => x(l:u:s,m)
+call sub_s(p, v, e)
+allocate(p(n))
+p(:) = x(:,m)
+call sub_s(p(l:u:s), v, e)
+deallocate(p)
+allocate(p(e))
+p(:) = x(l:u:s,m)
+call sub_s(p, v,
