Re: [Patch, fortran] PR84115] [8 Regression] ICE: tree check: expected tree that contains 'decl minimal' structure, have 'indirect_ref' in add_decl_as_local, at fortran/trans-decl.c:256

Re: [Patch, fortran] PR84115] [8 Regression] ICE: tree check: expected tree that contains 'decl minimal' structure, have 'indirect_ref' in add_decl_as_local, at fortran/trans-decl.c:256

[Paul Richard Thomas]

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

> Oddly, the failing test in associate_35.f90 is the only one that works
> in 7-branch. I have left the PR open and changed the title
> accordingly.

The attached patch fixes this. OK for trunk?

Paul

2018-02-16  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/84115
    * resolve.c (resolve_assoc_var): If a non-constant target expr.
    has no string length expression, make the associate variable
    into a deferred length, allocatable symbol.
    * trans-decl.c (gfc_is_reallocatable_lhs): Add and use a ptr to
    the symbol.
    * trans-stmt.c (trans_associate_var): Null and free scalar
    associate names that are allocatable. After assignment, remove
    the allocatable attribute to prevent reallocation.

2018-02-16  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/84115
    * gfortran.dg/associate_35.f90: Remove error, add stop n's and
    change to run.

[-- Attachment #2: submit2.diff --]
[-- Type: text/plain, Size: 8297 bytes --]

Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c	(revision 257682)
--- gcc/fortran/primary.c	(working copy)
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2082,2088 ****
      {
        bool permissible;
  
!       /* These target expressions can ge resolved at any time.  */
        permissible = tgt_expr && tgt_expr->symtree && tgt_expr->symtree->n.sym
  		    && (tgt_expr->symtree->n.sym->attr.use_assoc
  			|| tgt_expr->symtree->n.sym->attr.host_assoc
--- 2082,2088 ----
      {
        bool permissible;
  
!       /* These target expressions can be resolved at any time.  */
        permissible = tgt_expr && tgt_expr->symtree && tgt_expr->symtree->n.sym
  		    && (tgt_expr->symtree->n.sym->attr.use_assoc
  			|| tgt_expr->symtree->n.sym->attr.host_assoc
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 257682)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8635,8641 ****
    if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
      {
        if (!sym->ts.u.cl)
! 	sym->ts.u.cl = target->ts.u.cl;
  
        if (!sym->ts.u.cl->length && !sym->ts.deferred)
  	{
--- 8635,8654 ----
    if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
      {
        if (!sym->ts.u.cl)
! 	{
! 	  if (target->expr_type != EXPR_CONSTANT
! 	      && !target->ts.u.cl->length)
! 	    {
! 	      sym->ts.u.cl = gfc_get_charlen();
! 	      sym->ts.deferred = 1;
! 
! 	      /* This is reset in trans-stmt.c after the assignment
! 		 of the target expression to the associate name.  */
! 	      sym->attr.allocatable = 1;
! 	    }
! 	  else
! 	    sym->ts.u.cl = target->ts.u.cl;
! 	}
  
        if (!sym->ts.u.cl->length && !sym->ts.deferred)
  	{
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 257682)
--- gcc/fortran/trans-array.c	(working copy)
*************** bool
*** 9470,9498 ****
  gfc_is_reallocatable_lhs (gfc_expr *expr)
  {
    gfc_ref * ref;
  
    if (!expr->ref)
      return false;
  
    /* An allocatable class variable with no reference.  */
!   if (expr->symtree->n.sym->ts.type == BT_CLASS
!       && CLASS_DATA (expr->symtree->n.sym)->attr.allocatable
        && expr->ref && expr->ref->type == REF_COMPONENT
        && strcmp (expr->ref->u.c.component->name, "_data") == 0
        && expr->ref->next == NULL)
      return true;
  
    /* An allocatable variable.  */
!   if (expr->symtree->n.sym->attr.allocatable
  	&& expr->ref
  	&& expr->ref->type == REF_ARRAY
  	&& expr->ref->u.ar.type == AR_FULL)
      return true;
  
    /* All that can be left are allocatable components.  */
!   if ((expr->symtree->n.sym->ts.type != BT_DERIVED
!        && expr->symtree->n.sym->ts.type != BT_CLASS)
! 	|| !expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
      return false;
  
    /* Find a component ref followed by an array reference.  */
--- 9470,9501 ----
  gfc_is_reallocatable_lhs (gfc_expr *expr)
  {
    gfc_ref * ref;
+   gfc_symbol *sym;
  
    if (!expr->ref)
      return false;
  
+   sym = expr->symtree->n.sym;
+ 
    /* An allocatable class variable with no reference.  */
!   if (sym->ts.type == BT_CLASS
!       && CLASS_DATA (sym)->attr.allocatable
        && expr->ref && expr->ref->type == REF_COMPONENT
        && strcmp (expr->ref->u.c.component->name, "_data") == 0
        && expr->ref->next == NULL)
      return true;
  
    /* An allocatable variable.  */
!   if (sym->attr.allocatable
  	&& expr->ref
  	&& expr->ref->type == REF_ARRAY
  	&& expr->ref->u.ar.type == AR_FULL)
      return true;
  
    /* All that can be left are allocatable components.  */
!   if ((sym->ts.type != BT_DERIVED
!        && sym->ts.type != BT_CLASS)
! 	|| !sym->ts.u.derived->attr.alloc_comp)
      return false;
  
    /* Find a component ref followed by an array reference.  */
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 257682)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_derived_to_class (gfc_se *parms
*** 657,663 ****
  	      }
  
  	  /* Array references with vector subscripts and non-variable expressions
! 	     need be coverted to a one-based descriptor.  */
  	  if (ref || e->expr_type != EXPR_VARIABLE)
  	    {
  	      for (dim = 0; dim < e->rank; ++dim)
--- 657,663 ----
  	      }
  
  	  /* Array references with vector subscripts and non-variable expressions
! 	     need be converted to a one-based descriptor.  */
  	  if (ref || e->expr_type != EXPR_VARIABLE)
  	    {
  	      for (dim = 0; dim < e->rank; ++dim)
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 257682)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1926,1934 ****
--- 1926,1951 ----
      {
        gfc_expr *lhs;
        tree res;
+       gfc_se se;
+ 
+       gfc_init_se (&se, NULL);
+ 
+       /* resolve.c converts some associate names to allocatable so that
+ 	 allocation can take place automatically in gfc_trans_assignment.
+ 	 The frontend prevents them from being either allocated,
+ 	 deallocated or reallocated.  */
+       if (sym->attr.allocatable)
+ 	{
+ 	  tmp = sym->backend_decl;
+ 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ 	    tmp = gfc_conv_descriptor_data_get (tmp);
+ 	  gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
+ 						    null_pointer_node));
+ 	}
  
        lhs = gfc_lval_expr_from_sym (sym);
        res = gfc_trans_assignment (lhs, e, false, true);
+       gfc_add_expr_to_block (&se.pre, res);
  
        tmp = sym->backend_decl;
        if (e->expr_type == EXPR_FUNCTION
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1948,1955 ****
--- 1965,1989 ----
  	  tmp = gfc_deallocate_pdt_comp (CLASS_DATA (sym)->ts.u.derived,
  					 tmp, 0);
  	}
+       else if (sym->attr.allocatable)
+ 	{
+ 	  tmp = sym->backend_decl;
+ 
+ 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ 	    tmp = gfc_conv_descriptor_data_get (tmp);
+ 
+ 	  /* A simple call to free suffices here.  */
+ 	  tmp = gfc_call_free (tmp);
+ 
+ 	  /* Make sure that reallocation on assignment cannot occur.  */
+ 	  sym->attr.allocatable = 0;
+ 	}
+       else
+ 	tmp = NULL_TREE;
  
+       res = gfc_finish_block (&se.pre);
        gfc_add_init_cleanup (block, res, tmp);
+       gfc_free_expr (lhs);
      }
  
    /* Set the stringlength, when needed.  */
Index: gcc/testsuite/gfortran.dg/associate_35.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_35.f90	(revision 257682)
--- gcc/testsuite/gfortran.dg/associate_35.f90	(working copy)
***************
*** 1,6 ****
! ! { dg-do compile }
  !
! ! Test the fix for PR84115 comment #1 (except for s1(x)!).
  !
  ! Contributed by G Steinmetz  <gscfq@t-online.de>
  !
--- 1,6 ----
! ! { dg-do run }
  !
! ! Test the fix for PR84115 comment #1.
  !
  ! Contributed by G Steinmetz  <gscfq@t-online.de>
  !
***************
*** 14,35 ****
  contains
    subroutine s1(x)
      character(:), allocatable :: x
!     associate (y => x//x)   ! { dg-error "type character and non-constant length" }
!       print *, y
      end associate
    end
  
    subroutine s2(x)
      character(:), allocatable :: x
      associate (y => [x])
!       print *, y
      end associate
    end
  
    subroutine s3(x)
      character(:), allocatable :: x
      associate (y => [x,x])
!       print *, y
      end associate
    end
  end
--- 14,35 ----
  contains
    subroutine s1(x)
      character(:), allocatable :: x
!     associate (y => x//x)
!       if (y .ne. x//x) stop 1
      end associate
    end
  
    subroutine s2(x)
      character(:), allocatable :: x
      associate (y => [x])
!       if (any(y .ne. [x])) stop 2
      end associate
    end
  
    subroutine s3(x)
      character(:), allocatable :: x
      associate (y => [x,x])
!       if (any(y .ne. [x,x])) stop 3
      end associate
    end
  end

Re: [Patch, fortran] PR84115] [8 Regression] ICE: tree check: expected tree that contains 'decl minimal' structure, have 'indirect_ref' in add_decl_as_local, at fortran/trans-decl.c:256

[Steve Kargl]

On Fri, Feb 16, 2018 at 07:07:53AM +0000, Paul Richard Thomas wrote:
> > Oddly, the failing test in associate_35.f90 is the only one that works
> > in 7-branch. I have left the PR open and changed the title
> > accordingly.
> 
> The attached patch fixes this. OK for trunk?
> 

Ok.

-- 
steve

Re: [Patch, fortran] PR84115] [8 Regression] ICE: tree check: expected tree that contains 'decl minimal' structure, have 'indirect_ref' in add_decl_as_local, at fortran/trans-decl.c:256

[Paul Richard Thomas]

Thanks. Committed as revision 257781.

Paul

On 16 February 2018 at 15:21, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Fri, Feb 16, 2018 at 07:07:53AM +0000, Paul Richard Thomas wrote:
>> > Oddly, the failing test in associate_35.f90 is the only one that works
>> > in 7-branch. I have left the PR open and changed the title
>> > accordingly.
>>
>> The attached patch fixes this. OK for trunk?
>>
>
> Ok.
>
> --
> steve



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

[Patch, fortran] PR84115] [8 Regression] ICE: tree check: expected tree that contains 'decl minimal' structure, have 'indirect_ref' in add_decl_as_local, at fortran/trans-decl.c:256

[Paul Richard Thomas]

Committed a partial patch as 'obvious' in revision 257363.

Oddly, the failing test in associate_35.f90 is the only one that works
in 7-branch. I have left the PR open and changed the title
accordingly.

Paul

2018-02-04  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/84115
    * trans-decl.c (gfc_get_symbol_decl): Do not finish the decl of
    'length' if the symbol charlen backend_decl is an indirect ref.

2018-02-04  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/84115
    * gfortran.dg/associate_34.f90: New test.
    * gfortran.dg/associate_35.f90: New test.