This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR66679 - [OOP] ICE with class(*) and transfer


The comment in the patch says it all.

Bootstrapped and regtested on FC28/x86_64 - OK for trunk?

Paul

2018-07-05  Paul Thomas  <pault@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  <pault@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.miha@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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]