[Patch, fortran] PR109451 - ICE in gfc_conv_expr_descriptor with ASSOCIATE and substrings

[Paul Richard Thomas via Gcc-patches]

Hi All,

I think that the changelog says it all. OK for mainline?

Paul

Fortran: Fix some deferred character problems in associate [PR109451]

2023-04-07  Paul Thomas  <pa...@gcc.gnu.org>

gcc/fortran
PR fortran/109451
* trans-array.cc (gfc_conv_expr_descriptor): Guard expression
character length backend decl before using it. Suppress the
assignment if lhs equals rhs.
* trans-io.cc (gfc_trans_transfer): Scalarize transfer of
associate variables pointing to a variable. Add comment.


gcc/testsuite/
PR fortran/109451
* gfortran.dg/associate_61.f90 : New test

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e1725808033..3d90a02cdac 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7934,8 +7934,12 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  else
 	    tmp = se->string_length;
 
-	  if (expr->ts.deferred && VAR_P (expr->ts.u.cl->backend_decl))
-	    gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
+	  if (expr->ts.deferred && expr->ts.u.cl->backend_decl
+	      && VAR_P (expr->ts.u.cl->backend_decl))
+	    {
+	      if (expr->ts.u.cl->backend_decl != tmp)
+	        gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
+	    }
 	  else
 	    expr->ts.u.cl->backend_decl = tmp;
 	}
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 9b54d2f0d31..67658769b9e 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2620,9 +2620,13 @@ gfc_trans_transfer (gfc_code * code)
 	  gcc_assert (ref && ref->type == REF_ARRAY);
 	}
 
+      /* These expressions don't always have the dtype element length set
+	 correctly, rendering them useless for array transfer.  */
       if (expr->ts.type != BT_CLASS
 	 && expr->expr_type == EXPR_VARIABLE
 	 && ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred)
+	     || (expr->symtree->n.sym->assoc
+		 && expr->symtree->n.sym->assoc->variable)
 	     || gfc_expr_attr (expr).pointer))
 	goto scalarize;
 

! { dg-do run }
! Test fixes for PR109451
! Contributed by Harald Anlauf  <anl...@gcc.gnu.org>
!
  call dcs3(['abcd','efgh'])
contains
  subroutine dcs3(a)
    character(len=*), intent(in)  :: a(:)
    character(:),     allocatable :: b(:)
    b = a(:)
    call test (b, a, 1)
    associate (q => b(:))    ! no ICE but print repeated first element
      call test (q, a, 2)
      print *, q
    end associate
    associate (q => b(:)(:)) ! ICE
      call test (q, a, 3)
      associate (r => q(:)(1:3))
        call test (r, a(:)(1:3), 4)
      end associate
    end associate
    associate (q => b(:)(2:3))
      call test (q, a(:)(2:3), 5)
    end associate
  end subroutine dcs3
  subroutine test (x, y, i)
    character(len=*), intent(in) :: x(:), y(:)
    integer, intent(in) :: i
    if (any (x .ne. y)) stop i
  end subroutine test
end
! { dg-output " abcdefgh" }