[fortran] PR91726 - [7/8/9/10 Regression] ICE in gfc_conv_array_ref, at fortran/trans-array.c:3612

Message ID CAGkQGiJMX2jGBY=xE8wXeg7S3LSQN-Q3Y=u4Uh0hq_mUtug9AQ@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR91726 - [7/8/9/10 Regression] ICE in gfc_conv_array_ref, at fortran/trans-array.c:3612
Related show

Commit Message

Paul Richard Thomas Sept. 22, 2019, 3:28 p.m.
Fixing the original problem in the module took a few minutes. Making
the module do something useful took rather longer! The testcase in the
patch compiles with 6-branch but segfaults in runtime.

Bootstrapped and regtested on FC30/x86_64 - OK to commit and go
steadily back through the branches over some weeks?

Regards

Paul

2019-09-22  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/91726
    * resolve.c (gfc_expr_to_initialize): Bail out with a copy of
    the original expression if the array ref is a scalar and the
    array_spec has corank.
    * trans-array.c (gfc_conv_array_ref): Such expressions are OK
    even if the array ref codimen is zero.
    * trans-expr.c (gfc_get_class_from_expr): New function taken
    from gfc_get_vptr_from_expr.
    (gfc_get_vptr_from_expr): Call new function.
    * trans-stmt.c (trans_associate_var): If one of these is a
    target expression, extract the class expression from the target
    and copy its fields to a new target variable.
    * trans.h : Add prototype for gfc_get_class_from_expr.

2019-09-22  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/91726
    * gfortran.dg/coarray_poly_9.f90 : New test.

Comments

Steve Kargl Sept. 28, 2019, 5:01 p.m. | #1
On Sun, Sep 22, 2019 at 04:28:49PM +0100, Paul Richard Thomas wrote:
> Fixing the original problem in the module took a few minutes. Making

> the module do something useful took rather longer! The testcase in the

> patch compiles with 6-branch but segfaults in runtime.

> 

> Bootstrapped and regtested on FC30/x86_64 - OK to commit and go

> steadily back through the branches over some weeks?

> 

> Regards

> 

> Paul

> 

> 2019-09-22  Paul Thomas  <pault@gcc.gnu.org>

> 

>     PR fortran/91726

>     * resolve.c (gfc_expr_to_initialize): Bail out with a copy of

>     the original expression if the array ref is a scalar and the

>     array_spec has corank.

>     * trans-array.c (gfc_conv_array_ref): Such expressions are OK

>     even if the array ref codimen is zero.

>     * trans-expr.c (gfc_get_class_from_expr): New function taken

>     from gfc_get_vptr_from_expr.

>     (gfc_get_vptr_from_expr): Call new function.

>     * trans-stmt.c (trans_associate_var): If one of these is a

>     target expression, extract the class expression from the target

>     and copy its fields to a new target variable.

>     * trans.h : Add prototype for gfc_get_class_from_expr.

> 

> 2019-09-22  Paul Thomas  <pault@gcc.gnu.org>

> 

>     PR fortran/91726

>     * gfortran.dg/coarray_poly_9.f90 : New test.


Looks good to me.

-- 
Steve

Patch

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 275799)
--- gcc/fortran/resolve.c	(working copy)
*************** gfc_expr_to_initialize (gfc_expr *e)
*** 7433,7438 ****
--- 7433,7442 ----
    for (ref = result->ref; ref; ref = ref->next)
      if (ref->type == REF_ARRAY && ref->next == NULL)
        {
+ 	if (ref->u.ar.dimen == 0
+ 	    && ref->u.ar.as && ref->u.ar.as->corank)
+ 	  return result;
+
  	ref->u.ar.type = AR_FULL;

  	for (i = 0; i < ref->u.ar.dimen; i++)
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 275799)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 3609,3615 ****

    if (ar->dimen == 0)
      {
!       gcc_assert (ar->codimen || sym->attr.select_rank_temporary);

        if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
  	se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
--- 3609,3616 ----

    if (ar->dimen == 0)
      {
!       gcc_assert (ar->codimen || sym->attr.select_rank_temporary
! 		  || (ar->as && ar->as->corank));

        if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
  	se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 275799)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_reset_len (stmtblock_t *block, gfc_e
*** 472,482 ****
  }


! /* Obtain the vptr of the last class reference in an expression.
     Return NULL_TREE if no class reference is found.  */

  tree
! gfc_get_vptr_from_expr (tree expr)
  {
    tree tmp;
    tree type;
--- 472,482 ----
  }


! /* Obtain the last class reference in an expression.
     Return NULL_TREE if no class reference is found.  */

  tree
! gfc_get_class_from_expr (tree expr)
  {
    tree tmp;
    tree type;
*************** gfc_get_vptr_from_expr (tree expr)
*** 487,493 ****
        while (type)
  	{
  	  if (GFC_CLASS_TYPE_P (type))
! 	    return gfc_class_vptr_get (tmp);
  	  if (type != TYPE_CANONICAL (type))
  	    type = TYPE_CANONICAL (type);
  	  else
--- 487,493 ----
        while (type)
  	{
  	  if (GFC_CLASS_TYPE_P (type))
! 	    return tmp;
  	  if (type != TYPE_CANONICAL (type))
  	    type = TYPE_CANONICAL (type);
  	  else
*************** gfc_get_vptr_from_expr (tree expr)
*** 501,506 ****
--- 501,523 ----
      tmp = build_fold_indirect_ref_loc (input_location, tmp);

    if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
+     return tmp;
+
+   return NULL_TREE;
+ }
+
+
+ /* Obtain the vptr of the last class reference in an expression.
+    Return NULL_TREE if no class reference is found.  */
+
+ tree
+ gfc_get_vptr_from_expr (tree expr)
+ {
+   tree tmp;
+
+   tmp = gfc_get_class_from_expr (expr);
+
+   if (tmp != NULL_TREE)
      return gfc_class_vptr_get (tmp);

    return NULL_TREE;
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 275799)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 2099,2105 ****
--- 2099,2141 ----
  	}
        else
  	{
+ 	  tree ctree = gfc_get_class_from_expr (se.expr);
  	  tmp = TREE_TYPE (sym->backend_decl);
+
+ 	  /* Coarray scalar component expressions can emerge from
+ 	     the front end as array elements of the _data field.  */
+ 	  if (sym->ts.type == BT_CLASS
+ 	      && e->ts.type == BT_CLASS && e->rank == 0
+ 	      && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)) && ctree)
+ 	    {
+ 	      tree stmp;
+ 	      tree dtmp;
+
+ 	      se.expr = ctree;
+ 	      dtmp = TREE_TYPE (TREE_TYPE (sym->backend_decl));
+ 	      ctree = gfc_create_var (dtmp, "class");
+
+ 	      stmp = gfc_class_data_get (se.expr);
+ 	      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)));
+
+ 	      /* Set the fields of the target class variable.  */
+ 	      stmp = gfc_conv_descriptor_data_get (stmp);
+ 	      dtmp = gfc_class_data_get (ctree);
+ 	      stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ 	      gfc_add_modify (&se.pre, dtmp, stmp);
+ 	      stmp = gfc_class_vptr_get (se.expr);
+ 	      dtmp = gfc_class_vptr_get (ctree);
+ 	      stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ 	      gfc_add_modify (&se.pre, dtmp, stmp);
+ 	      if (UNLIMITED_POLY (sym))
+ 		{
+ 		  stmp = gfc_class_len_get (se.expr);
+ 		  dtmp = gfc_class_len_get (ctree);
+ 		  stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ 		  gfc_add_modify (&se.pre, dtmp, stmp);
+ 		}
+ 	      se.expr = ctree;
+ 	    }
  	  tmp = gfc_build_addr_expr (tmp, se.expr);
  	}

Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h	(revision 275799)
--- gcc/fortran/trans.h	(working copy)
*************** tree gfc_vptr_final_get (tree);
*** 434,439 ****
--- 434,440 ----
  tree gfc_vptr_deallocate_get (tree);
  void gfc_reset_vptr (stmtblock_t *, gfc_expr *);
  void gfc_reset_len (stmtblock_t *, gfc_expr *);
+ tree gfc_get_class_from_expr (tree);
  tree gfc_get_vptr_from_expr (tree);
  tree gfc_get_class_array_ref (tree, tree, tree, bool);
  tree gfc_copy_class_to_class (tree, tree, tree, bool);
Index: gcc/testsuite/gfortran.dg/coarray_poly_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_poly_9.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/coarray_poly_9.f90	(working copy)
***************
*** 0 ****
--- 1,38 ----
+ ! { dg-do run }
+ ! { dg-options "-fcoarray=single" }
+ !
+ ! Test the fix for PR91726.
+ !
+ ! Contributed by Gerhardt Steinmetz  <gscfq@t-online.de>
+ !
+ module m
+    type s
+       class(*), allocatable :: a[:]    ! This ICEd
+    end type
+    type t
+       class(*), allocatable :: a(:)[:] ! This was OK
+    end type
+ end
+
+   use m
+   call foo
+   call bar
+ contains
+   subroutine foo
+     type (s) :: a
+     integer(4) :: i = 42_4
+     allocate (a%a[*], source = i)     ! This caused runtime segfaults
+     select type (z => a%a)            ! ditto
+       type is (integer(4))
+       if (z .ne. 42_4) stop 1
+     end select
+   end subroutine
+   subroutine bar                      ! Arrays always worked
+     type (t) :: a
+     allocate (a%a(3)[*], source = [1_4, 2_4, 3_4])
+     select type (z => a%a)
+       type is (integer(4))
+       if (any (z .ne. [1_4, 2_4, 3_4])) stop 2
+     end select
+   end subroutine
+ end