Hi All,
The attached fixes this PR by dint of the change in class.c. The
changes to trans-array.c are largely cosmetic but the move of the call
to 'build_class_array_ref' ensures that all class array references go
by this route.
Boostrapped and regtested on FC27/x86_64 - OK to commit?
Regards
Paul
2018-02-27 Paul Thomas <[email protected]>
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-27 Paul Thomas <[email protected]>
PR fortran/84538
* gfortran.dg/pr84523.f90: New test.
Index: gcc/fortran/class.c
===================================================================
*** gcc/fortran/class.c (revision 257969)
--- gcc/fortran/class.c (working copy)
*************** class_array_ref_detected (gfc_ref *ref,
*** 308,314 ****
*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)
{
--- 308,313 ----
*************** find_intrinsic_vtab (gfc_typespec *ts)
*** 2630,2636 ****
{
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. */
--- 2629,2635 ----
{
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. */
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 257969)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3376,3382 ****
gfc_array_info *info;
tree decl = NULL_TREE;
tree index;
! tree tmp;
gfc_ss *ss;
gfc_expr *expr;
int n;
--- 3376,3382 ----
gfc_array_info *info;
tree decl = NULL_TREE;
tree index;
! tree base;
gfc_ss *ss;
gfc_expr *expr;
int n;
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3396,3401 ****
--- 3396,3408 ----
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 a class 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
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3420,3433 ****
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);
}
--- 3427,3433 ----
decl = info->descriptor;
}
! se->expr = gfc_build_array_ref (base, index, decl);
}
Index: gcc/testsuite/gfortran.dg/class_array_23.f03
===================================================================
*** gcc/testsuite/gfortran.dg/class_array_23.f03 (nonexistent)
--- gcc/testsuite/gfortran.dg/class_array_23.f03 (working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { 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 <[email protected]>
+ !
+ 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
