Sorry about the premature 'send'.
This one is more or less obvious and is described in the ChangeLog.
The key point is that full or section array references to intrinsic
components were returning a false true from expr.c (is_subref_array).
Returning false if a component is intrinsic and following anything
other than an array element is an obvious remedy.
Bootstrapped and regtested on FC28/x86_64 - OK for trunk and 8-branch?
Paul
2019-01-30 Paul Thomas <[email protected]>
PR fortran/88685
* expr.c (is_subref_array): Move the check for class pointer
dummy arrays to after the reference check. If we haven't seen
an array reference other than an element and a component is not
class or derived, return false.
2019-01-30 Paul Thomas <[email protected]>
PR fortran/88685
* gfortran.dg/pointer_array_component_3.f90 : New test.
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 268230)
--- gcc/fortran/expr.c (working copy)
*************** is_subref_array (gfc_expr * e)
*** 1072,1086 ****
if (e->symtree->n.sym->attr.subref_array_pointer)
return true;
- if (e->symtree->n.sym->ts.type == BT_CLASS
- && e->symtree->n.sym->attr.dummy
- && CLASS_DATA (e->symtree->n.sym)->attr.dimension
- && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer)
- return true;
-
seen_array = false;
for (ref = e->ref; ref; ref = ref->next)
{
if (ref->type == REF_ARRAY
&& ref->u.ar.type != AR_ELEMENT)
seen_array = true;
--- 1072,1086 ----
if (e->symtree->n.sym->attr.subref_array_pointer)
return true;
seen_array = false;
+
for (ref = e->ref; ref; ref = ref->next)
{
+ if (!seen_array && ref->type == REF_COMPONENT
+ && (ref->u.c.component->ts.type != BT_CLASS
+ && ref->u.c.component->ts.type != BT_DERIVED))
+ return false;
+
if (ref->type == REF_ARRAY
&& ref->u.ar.type != AR_ELEMENT)
seen_array = true;
*************** is_subref_array (gfc_expr * e)
*** 1089,1094 ****
--- 1089,1101 ----
&& ref->type != REF_ARRAY)
return seen_array;
}
+
+ if (e->symtree->n.sym->ts.type == BT_CLASS
+ && e->symtree->n.sym->attr.dummy
+ && CLASS_DATA (e->symtree->n.sym)->attr.dimension
+ && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer)
+ return true;
+
return false;
}
Index: gcc/testsuite/gfortran.dg/pointer_array_component_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 (working copy)
***************
*** 0 ****
--- 1,36 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR88685, in which the component array references in 'doit'
+ ! were being ascribed to the class pointer 'Cls' itself so that the stride
+ ! measure between elements was wrong.
+ !
+ ! Contributed by Antony Lewis <[email protected]>
+ !
+ program tester
+ implicit none
+ Type TArr
+ integer, allocatable :: CL(:)
+ end Type TArr
+
+ type(TArr), allocatable, target :: arr(:,:)
+ class(TArr), pointer:: Cls(:,:)
+ integer i
+
+ allocate(arr(1,1))
+ allocate(arr(1,1)%CL(3))
+ arr(1,1)%CL=-1
+ cls => arr
+ call doit(cls)
+ if (any (arr(1,1)%cl .ne. [3,2,1])) stop 3
+ contains
+ subroutine doit(cls)
+ class(TArr), pointer :: Cls(:,:)
+
+ cls(1,1)%CL(1) = 3
+ cls(1,1)%CL(2:3) = [2,1]
+
+ if (any (Cls(1,1)%CL .ne. [3,2,1])) stop 1
+ if (Cls(1,1)%CL(2) .ne. 2) stop 2
+
+ end subroutine doit
+ end program tester
