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
