@@ -2344,6 +2344,9 @@ typedef struct gfc_association_list
for memory handling. */
unsigned dangling:1;
+ /* True when the rank of the target expression is guessed during parsing. */
+ unsigned rankguessed:1;
+
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symtree *st; /* Symtree corresponding to name. */
locus where;
@@ -4098,6 +4098,7 @@ parse_associate (void)
int dim, rank = 0;
if (array_ref)
{
+ a->rankguessed = 1;
/* Count the dimension, that have a non-scalar extend. */
for (dim = 0; dim < array_ref->dimen; ++dim)
if (array_ref->dimen_type[dim] != DIMEN_ELEMENT
@@ -4777,7 +4777,7 @@ fail:
/* Given a variable expression node, compute the rank of the expression by
examining the base symbol and any reference structures it may have. */
-static void
+void
expression_rank (gfc_expr *e)
{
gfc_ref *ref;
@@ -8153,16 +8153,19 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
if (target->rank != 0)
{
gfc_array_spec *as;
- if (sym->ts.type != BT_CLASS && !sym->as)
+ /* The rank may be incorrectly guessed at parsing, therefore make sure
+ it is corrected now. */
+ if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed))
{
- as = gfc_get_array_spec ();
+ if (!sym->as)
+ sym->as = gfc_get_array_spec ();
+ as = sym->as;
as->rank = target->rank;
as->type = AS_DEFERRED;
as->corank = gfc_get_corank (target);
sym->attr.dimension = 1;
if (as->corank != 0)
sym->attr.codimension = 1;
- sym->as = as;
}
}
else
@@ -1569,7 +1569,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
if (sym->attr.subref_array_pointer)
{
gcc_assert (e->expr_type == EXPR_VARIABLE);
- tmp = e->symtree->n.sym->backend_decl;
+ tmp = e->symtree->n.sym->ts.type == BT_CLASS
+ ? gfc_class_data_get (e->symtree->n.sym->backend_decl)
+ : e->symtree->n.sym->backend_decl;
tmp = gfc_get_element_type (TREE_TYPE (tmp));
tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
gfc_add_modify (&se.pre, GFC_DECL_SPAN(desc), tmp);
new file mode 100644
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! Contributed by mrestelli@gmail.com
+! Adapated by Andre Vehreschild <vehre@gcc.gnu.org>
+! Test that fix for PR69296 is working.
+
+program p
+ implicit none
+
+ integer :: j, a(2,6), i(3,2)
+
+ a(1,:) = (/ ( j , j=1,6) /)
+ a(2,:) = (/ ( -10*j , j=1,6) /)
+
+ i(:,1) = (/ 1 , 3 , 5 /)
+ i(:,2) = (/ 4 , 5 , 6 /)
+
+ associate( ai => a(:,i(:,1)) )
+ if (any(shape(ai) /= [2, 3])) call abort()
+ if (any(reshape(ai, [6]) /= [1 , -10, 3, -30, 5, -50])) call abort()
+ end associate
+
+end program p
new file mode 100644
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! Contributed by mrestelli@gmail.com
+! Adapated by Andre Vehreschild <vehre@gcc.gnu.org>
+! Test that fix for PR69296 is working.
+
+program p
+ implicit none
+
+ type foo
+ integer :: i
+ end type
+
+ integer :: j, i(3,2)
+ class(foo), allocatable :: a(:,:)
+
+ allocate (a(2,6))
+
+ a(1,:)%i = (/ ( j , j=1,6) /)
+ a(2,:)%i = (/ ( -10*j , j=1,6) /)
+
+ i(:,1) = (/ 1 , 3 , 5 /)
+ i(:,2) = (/ 4 , 5 , 6 /)
+
+ associate( ai => a(:,i(:,1))%i )
+ if (any(shape(ai) /= [2, 3])) call abort()
+ if (any(reshape(ai, [6]) /= [1 , -10, 3, -30, 5, -50])) call abort()
+ end associate
+
+ deallocate(a)
+end program p