re PR fortran/88685 (pointer class array argument indexing)

2019-02-02  Paul Thomas  <pault@gcc.gnu.org>

	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-02-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/88685
	* gfortran.dg/pointer_array_component_3.f90 : New test.

From-SVN: r268472

4 files changed, 64 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0a5da36..1dc007d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	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-02-01  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/83246
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a9e7f36..a0eb94f 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1072,15 +1072,17 @@ is_subref_array (gfc_expr * e)
   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 we haven't seen the array reference and this is an intrinsic,
+	 what follows cannot be a subreference array.  */
+      if (!seen_array && ref->type == REF_COMPONENT
+	  && ref->u.c.component->ts.type != BT_CLASS
+	  && !gfc_bt_struct (ref->u.c.component->ts.type))
+	return false;
+
       if (ref->type == REF_ARRAY
 	    && ref->u.ar.type != AR_ELEMENT)
 	seen_array = true;
@@ -1089,6 +1091,13 @@ is_subref_array (gfc_expr * e)
 	    && 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;
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4687a66..bc9ca4c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/88685
+	* gfortran.dg/pointer_array_component_3.f90 : New test.
+
 2019-02-02  Jakub Jelinek  <jakub@redhat.com>
 
 	PR middle-end/87887
diff --git a/gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 b/gcc/testsuite/gfortran.dg/pointer_array_component_3.f90
new file mode 100644
index 0000000..8ef205b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_array_component_3.f90
@@ -0,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  <antony@cosmologist.info>
+!
+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