re PR fortran/84538 (Array of derived type elements incorrectly accessed in function)

2018-03-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84538
	* class.c (class_array_ref_detected): Remove the condition that
	there be no reference after the array reference.
	(find_intrinsic_vtab): Remove excess whitespace.
	* trans-array.c (gfc_conv_scalarized_array_ref): Rename 'tmp'
	as 'base and call build_class_array_ref earlier.

2018-03-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84538
	* gfortran.dg/class_array_23.f03: New test.

From-SVN: r258097

gcc/fortran/ChangeLog

+2018-03-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84538
+	* class.c (class_array_ref_detected): Remove the condition that
+	there be no reference after the array reference.
+	(find_intrinsic_vtab): Remove excess whitespace.
+	* trans-array.c (gfc_conv_scalarized_array_ref): Rename 'tmp'
+	as 'base and call build_class_array_ref earlier.
+
 2018-02-28  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/83901

gcc/fortran/class.c

@@ -308,7 +308,6 @@ class_array_ref_detected (gfc_ref *ref, bool *full_array)
 	    *full_array = true;
 	}
       else if (ref->next && ref->next->type == REF_ARRAY
-	    && !ref->next->next
 	    && ref->type == REF_COMPONENT
 	    && ref->next->u.ar.type != AR_ELEMENT)
 	{
@@ -2630,7 +2629,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
     {
       char tname[GFC_MAX_SYMBOL_LEN+1];
       char *name;
-      
+
       /* Encode all types as TYPENAME_KIND_ including especially character
 	 arrays, whose length is now consistently stored in the _len component
 	 of the class-variable.  */

gcc/fortran/trans-array.c

@@ -3376,7 +3376,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
   gfc_array_info *info;
   tree decl = NULL_TREE;
   tree index;
-  tree tmp;
+  tree base;
   gfc_ss *ss;
   gfc_expr *expr;
   int n;
@@ -3396,6 +3396,12 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
     index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
 			     index, info->offset);
 
+  base = build_fold_indirect_ref_loc (input_location, info->data);
+
+  /* Use the vptr 'size' field to access the element of a class array.  */
+  if (build_class_array_ref (se, base, index))
+    return;
+
   if (expr && ((is_subref_array (expr)
 		&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor)))
 	       || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE
@@ -3420,14 +3426,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
 	decl = info->descriptor;
     }
 
-  tmp = build_fold_indirect_ref_loc (input_location, info->data);
-
-  /* Use the vptr 'size' field to access a class the element of a class
-     array.  */
-  if (build_class_array_ref (se, tmp, index))
-    return;
-
-  se->expr = gfc_build_array_ref (tmp, index, decl);
+  se->expr = gfc_build_array_ref (base, index, decl);
 }
 
 

gcc/testsuite/ChangeLog

+2018-03-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84538
+	* gfortran.dg/class_array_23.f03: New test.
+
 2018-03-01  Richard Sandiford  <richard.sandiford@linaro.org>
 
 	PR rtl-optimization/84528

gcc/testsuite/gfortran.dg/class_array_23.f03

+! { dg-do run }
+!
+! Test the fix for PR84538 in which the scalarizer was taking the size
+! of 't', rather than 'te', to generate array references.
+!
+! Contributed by Andrew Benson  <abensonca@gmail.com>
+!
+module bugMod
+  public
+  type :: t
+     integer :: i
+  end type t
+  type, extends(t) :: te
+     integer :: j
+  end type te
+contains
+  subroutine check(n)
+    implicit none
+    class(t), intent(inout), dimension(:) :: n
+    integer :: i(2)
+    i = n%i ! Original testcase had this in a write statement. However,
+            ! it is the scalarizer that is getting the span wrong and so
+            ! this assignment failed too.
+    if (any (i .ne. [8,3])) stop 1
+    return
+  end subroutine check
+end module bugMod
+
+program bug
+  use bugMod
+  class(t), allocatable, dimension(:) :: n
+  allocate(te :: n(2))
+  n(1:2)%i=[8,3]
+  if (any (n%i .ne. [8,3])) stop 2
+  call check(n)
+  deallocate (n)
+end program bug