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 <pa...@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-27 Paul Thomas <pa...@gcc.gnu.org> 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 <abenso...@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