[Patch, fortran] PR57284 - [OOP] ICE with find_array_spec for polymorphic arrays

[Patch, fortran] PR57284 - [OOP] ICE with find_array_spec for polymorphic arrays

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 1111 bytes --]

The part of this patch in resolve.c had essentially already been
sorted out by Tobias Burnus in comment #2 of the PR. I suspect that he
must have been put off the trail by the segfault that occurred when
this was implemented. In the end, the reason for the segfault is quite
straight forward and comes about because the temporary declarations
representing class actual arguments cause gfc_conv_component_ref to
barf, when porcessing the _data component. However, they are amenable
to gfc_class_data_get and so this is used in the fix.

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

Paul

2019-04-19  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/57284
    * resolve.c (find_array_spec): If this is a class expression
    and the symbol and component array specs are the same, this is
    not an error.
    *trans-intrinsic.c (gfc_conv_intrinsic_size): If a class symbol
    argument, has no namespace, it has come from the interface
    mapping and the _data component must be accessed directly.

2019-04-19  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/57284
    * gfortran.dg/class_70.f03

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 4932 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 270352)
--- gcc/fortran/resolve.c	(working copy)
*************** find_array_spec (gfc_expr *e)
*** 4712,4720 ****
    gfc_array_spec *as;
    gfc_component *c;
    gfc_ref *ref;
  
    if (e->symtree->n.sym->ts.type == BT_CLASS)
!     as = CLASS_DATA (e->symtree->n.sym)->as;
    else
      as = e->symtree->n.sym->as;
  
--- 4712,4724 ----
    gfc_array_spec *as;
    gfc_component *c;
    gfc_ref *ref;
+   bool class_as = false;
  
    if (e->symtree->n.sym->ts.type == BT_CLASS)
!     {
!       as = CLASS_DATA (e->symtree->n.sym)->as;
!       class_as = true;
!     }
    else
      as = e->symtree->n.sym->as;
  
*************** find_array_spec (gfc_expr *e)
*** 4733,4739 ****
  	c = ref->u.c.component;
  	if (c->attr.dimension)
  	  {
! 	    if (as != NULL)
  	      gfc_internal_error ("find_array_spec(): unused as(1)");
  	    as = c->as;
  	  }
--- 4737,4743 ----
  	c = ref->u.c.component;
  	if (c->attr.dimension)
  	  {
! 	    if (as != NULL && !(class_as && as == c->as))
  	      gfc_internal_error ("find_array_spec(): unused as(1)");
  	    as = c->as;
  	  }
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c	(revision 270352)
--- gcc/fortran/trans-intrinsic.c	(working copy)
*************** gfc_conv_intrinsic_size (gfc_se * se, gf
*** 7446,7451 ****
--- 7446,7453 ----
    tree fncall0;
    tree fncall1;
    gfc_se argse;
+   gfc_expr *e;
+   gfc_symbol *sym = NULL;
  
    gfc_init_se (&argse, NULL);
    actual = expr->value.function.actual;
*************** gfc_conv_intrinsic_size (gfc_se * se, gf
*** 7453,7464 ****
    if (actual->expr->ts.type == BT_CLASS)
      gfc_add_class_array_ref (actual->expr);
  
    argse.data_not_needed = 1;
!   if (gfc_is_class_array_function (actual->expr))
      {
        /* For functions that return a class array conv_expr_descriptor is not
  	 able to get the descriptor right.  Therefore this special case.  */
!       gfc_conv_expr_reference (&argse, actual->expr);
        argse.expr = gfc_build_addr_expr (NULL_TREE,
  					gfc_class_data_get (argse.expr));
      }
--- 7455,7485 ----
    if (actual->expr->ts.type == BT_CLASS)
      gfc_add_class_array_ref (actual->expr);
  
+   e = actual->expr;
+ 
+   /* These are emerging from the interface mapping, when a class valued
+      function appears as the rhs in a realloc on assign statement, where
+      the size of the result is that of one of the actual arguments.  */
+   if (e->expr_type == EXPR_VARIABLE
+       && e->symtree->n.sym->ns == NULL /* This is distinctive!  */
+       && e->symtree->n.sym->ts.type == BT_CLASS
+       && e->ref && e->ref->type == REF_COMPONENT
+       && strcmp (e->ref->u.c.component->name, "_data") == 0)
+     sym = e->symtree->n.sym;
+ 
    argse.data_not_needed = 1;
!   if (gfc_is_class_array_function (e))
      {
        /* For functions that return a class array conv_expr_descriptor is not
  	 able to get the descriptor right.  Therefore this special case.  */
!       gfc_conv_expr_reference (&argse, e);
!       argse.expr = gfc_build_addr_expr (NULL_TREE,
! 					gfc_class_data_get (argse.expr));
!     }
!   else if (sym && sym->backend_decl)
!     {
!       gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (sym->backend_decl)));
!       argse.expr = sym->backend_decl;
        argse.expr = gfc_build_addr_expr (NULL_TREE,
  					gfc_class_data_get (argse.expr));
      }
Index: gcc/testsuite/gfortran.dg/class_70.f03
===================================================================
*** gcc/testsuite/gfortran.dg/class_70.f03	(nonexistent)
--- gcc/testsuite/gfortran.dg/class_70.f03	(working copy)
***************
*** 0 ****
--- 1,38 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR57284 - [OOP] ICE with find_array_spec for polymorphic
+ ! arrays. Once thw ICE was fixed, work was needed to fix a segfault while
+ ! determining the size of 'z'.
+ !
+ ! Contributed by Lorenz Huedepohl  <bugs@stellardeath.org>
+ !
+ module testmod
+   type type_t
+     integer :: idx
+   end type type_t
+   type type_u
+      type(type_t), allocatable :: cmp(:)
+   end type
+ contains
+   function foo(a, b) result(add)
+     class(type_t), intent(in) :: a(:), b(size(a))
+     type(type_t) :: add(size(a))
+     add%idx = a%idx + b%idx
+   end function
+ end module testmod
+ program p
+   use testmod
+   class(type_t), allocatable, dimension(:) :: x, y, z
+   class(type_u), allocatable :: w
+   allocate (x, y, source = [type_t (1), type_t(2)])
+   z = foo (x, y)
+   if (any (z%idx .ne. [2, 4])) stop 1
+ 
+ ! Try something a bit more complicated than the original.
+ 
+   allocate (w)
+   allocate (w%cmp, source = [type_t (2), type_t(3)])
+   z = foo (w%cmp, y)
+   if (any (z%idx .ne. [3, 5])) stop 2
+   deallocate (w, x, y, z)
+ end program

Re: [Patch, fortran] PR57284 - [OOP] ICE with find_array_spec for polymorphic arrays

[Steve Kargl]

On Fri, Apr 19, 2019 at 06:19:00PM +0100, Paul Richard Thomas wrote:
> The part of this patch in resolve.c had essentially already been
> sorted out by Tobias Burnus in comment #2 of the PR. I suspect that he
> must have been put off the trail by the segfault that occurred when
> this was implemented. In the end, the reason for the segfault is quite
> straight forward and comes about because the temporary declarations
> representing class actual arguments cause gfc_conv_component_ref to
> barf, when porcessing the _data component. However, they are amenable
> to gfc_class_data_get and so this is used in the fix.
> 
> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?
> 

Looks good to me.  Where are we in the release cycle?
Do you need release manager approval to apply the 
patch?

-- 
Steve

Re: [Patch, fortran] PR57284 - [OOP] ICE with find_array_spec for polymorphic arrays

[Paul Richard Thomas]

Thanks, Steve.

Committed as revision 270489.

Paul

On Fri, 19 Apr 2019 at 18:28, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> On Fri, Apr 19, 2019 at 06:19:00PM +0100, Paul Richard Thomas wrote:
> > The part of this patch in resolve.c had essentially already been
> > sorted out by Tobias Burnus in comment #2 of the PR. I suspect that he
> > must have been put off the trail by the segfault that occurred when
> > this was implemented. In the end, the reason for the segfault is quite
> > straight forward and comes about because the temporary declarations
> > representing class actual arguments cause gfc_conv_component_ref to
> > barf, when porcessing the _data component. However, they are amenable
> > to gfc_class_data_get and so this is used in the fix.
> >
> > Bootstrapped and regtested on FC29/x86_64 - OK for trunk?
> >
>
> Looks good to me.  Where are we in the release cycle?
> Do you need release manager approval to apply the
> patch?
>
> --
> Steve



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein