[Bug fortran/95868] New: Derived-type deferred-length character component handling broken

[burnus at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95868

            Bug ID: 95868
           Summary: Derived-type deferred-length character component
                    handling broken
           Product: gcc
           Version: 10.0
            Status: UNCONFIRMED
          Keywords: ice-on-valid-code, wrong-code
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: burnus at gcc dot gnu.org
  Target Milestone: ---

The following program fails with an ICE or a segfault.

Issues I observed:

* For the ICE, the issue seems to be:
  gfc_conv_loop_setup() calls
    gfc_add_loop_ss_code (loop, loop->ss, false, where)
      expr = ss_info->expr;
         case GFC_SS_SCALAR:
          gfc_conv_expr (&se, expr);
  → The ICE occur because expr == NULL and expr is dereferenced.

  I am not sure whether it is the following code, but it sets
  ss-info->expr and I bet ss.end == NULL in my testcase, but I
  have not check it: 
    gfc_walk_array_ref()
      if (ref->type == REF_SUBSTRING)
        {
          ss = gfc_get_scalar_ss (ss, ref->u.ss.start);
          ss = gfc_get_scalar_ss (ss, ref->u.ss.end);
        }
    and the second argument is the 'expr'.


* For derived-type deferred strings, one often has the intcst "0" in the tree.
  for gfc_conv_expr_descriptor, for the simple case, that's handled
  (search: deferred_array_component).
  However, for the complicated case, one might end up with
    "0 = 0;"
  which the gimplifier does not like.
  I am not sure whether the patch is correct, but it fixes one testcase
  for me (not shown, OpenMP one) and looks more sensible. I am not sure
  whether VAR_P(se->string_length) makes sense and when it gets set or
  defined. 

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 54e1107c711..6da8c6d5595 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7551,15 +7551,14 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       /* Set the string_length for a character array.  */
       if (expr->ts.type == BT_CHARACTER)
        {
-         se->string_length =  gfc_get_expr_charlen (expr);
-         if (VAR_P (se->string_length)
-             && expr->ts.u.cl->backend_decl == se->string_length)
-           tmp = ss_info->string_length;
-         else
-           tmp = se->string_length;
-
-         if (expr->ts.deferred)
-           gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
+         tmp = gfc_get_expr_charlen (expr);
+         if (!VAR_P (expr->ts.u.cl->backend_decl))
+           se->string_length = (expr->ts.deferred ? ss_info->string_length
+                                                  : tmp);
+         else if (expr->ts.deferred
+                  && se->string_length != expr->ts.u.cl->backend_decl)
+           gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
+                           ss_info->string_length);
        }

       /* If we have an array section, are assigning  or passing an array

--------------
implicit none
type t
  character(len=:), allocatable :: str(:)
end type t
type (t) :: var
character(len=:), allocatable :: str(:)
integer :: i

allocate(character(len=3) :: str(3))
str(:) = ["abc", "def", "ghi"]
!call dummy(str)        ! OK
!call dummy(str(2:))    ! OK
!call dummy(str(:)(2:)) ! (1) ICE

!call sub1(str)         ! OK
!call sub2(str(2:))     ! (2) Segfault at runtime
!call sub3(str(:)(2:))  ! (3) ICE

var%str = ["abc", "def", "ghi"]
!call sub1(var%str)        ! (4) Fails at runtime ('stop 1')
!call sub2(var%str(2:))    ! (5) Fails at runtime ('stop 1')
!call sub3(var%str(:)(2:)) ! ICE
deallocate(str,var%str)
contains
  subroutine dummy(x)
    character(len=1), dimension(*) :: x
  end
  subroutine sub1(x)
    character(len=*), dimension(*) :: x
    if (len(x) /= 3) stop 1
    if (any (x(1:3) /= ["abc", "def", "ghi"])) stop 2
  end
  subroutine sub2(x)
    character(len=*), dimension(*) :: x
    if (len(x) /= 3) stop 3
    if (any (x(1:2) /= ["def", "ghi"])) stop 4
  end
  subroutine sub3(x)
    character(len=*), dimension(*) :: x
    if (len(x) /= 2) stop 5
    if (any (x(1:3) /= ["bc", "ef", "hi"])) stop 6
  end
end