The comment in the patch says it all.
Bootstrapped and regtested on FC28/x86_64 - OK for trunk?
Paul
2018-07-05 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/66679
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Class array
elements are returned as references to the data element. Get
the class expression by stripping back the references. Use this
for the element size.
2018-07-05 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/66679
* gfortran.dg/transfer_class_3.f90: New test.
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (revision 262299)
--- gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 7346,7358 ****
tree upper;
tree lower;
tree stmt;
gfc_actual_arglist *arg;
gfc_se argse;
gfc_array_info *info;
stmtblock_t block;
int n;
bool scalar_mold;
! gfc_expr *source_expr, *mold_expr;
info = NULL;
if (se->loop)
--- 7346,7359 ----
tree upper;
tree lower;
tree stmt;
+ tree class_ref = NULL_TREE;
gfc_actual_arglist *arg;
gfc_se argse;
gfc_array_info *info;
stmtblock_t block;
int n;
bool scalar_mold;
! gfc_expr *source_expr, *mold_expr, *class_expr;
info = NULL;
if (se->loop)
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 7383,7389 ****
{
gfc_conv_expr_reference (&argse, arg->expr);
if (arg->expr->ts.type == BT_CLASS)
! source = gfc_class_data_get (argse.expr);
else
source = argse.expr;
--- 7384,7407 ----
{
gfc_conv_expr_reference (&argse, arg->expr);
if (arg->expr->ts.type == BT_CLASS)
! {
! tmp = build_fold_indirect_ref_loc (input_location, argse.expr);
! if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
! source = gfc_class_data_get (tmp);
! else
! {
! /* Array elements are evaluated as a reference to the data.
! To obtain the vptr for the element size, the argument
! expression must be stripped to the class reference and
! re-evaluated. The pre and post blocks are not needed. */
! gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
! source = argse.expr;
! class_expr = gfc_find_and_cut_at_last_class_ref (arg->expr);
! gfc_init_se (&argse, NULL);
! gfc_conv_expr (&argse, class_expr);
! class_ref = argse.expr;
! }
! }
else
source = argse.expr;
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 7395,7400 ****
--- 7413,7421 ----
argse.string_length);
break;
case BT_CLASS:
+ if (class_ref != NULL_TREE)
+ tmp = gfc_class_vtab_size_get (class_ref);
+ else
tmp = gfc_class_vtab_size_get (argse.expr);
break;
default:
Index: gcc/testsuite/gfortran.dg/transfer_class_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/transfer_class_3.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/transfer_class_3.f90 (working copy)
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR66679.
+ !
+ ! Contributed by Miha Polajnar <polajnar.m...@gmail.com>
+ !
+ program main
+ implicit none
+ class(*), allocatable :: vec(:)
+ integer :: var, ans(2)
+ allocate(vec(2),source=[1_4, 2_4])
+
+ ! This worked correctly.
+ if (any (transfer(vec,[var],2) .ne. [1_4, 2_4])) stop 1
+
+ ! This caused an ICE.
+ if (any ([transfer(vec(1),[var]), transfer(vec(2),[var])] .ne. [1_4, 2_4])) stop 2
+ end program main
