I spent far more time on this PR because I was focusing on entirely
the wrong place in the code. Or, rather the clue that was needed for
the fix was elswhere. The type declarations for the deferred character
length dummies were not being generated. Rather than being a problem
in the associate block, as I thought initially, it turned out to be
the cast in print *, allocated(x),..... that was throwing the
gimplifier in its attempt to inline the subroutine. The fix is clear
from the ChangeLog.
It did turn out that there was something wrong with the associate
block: The associate name was ending up with no charlen and so winding
up with a descriptor appropriate to a bind(C) function result.
Bootstraps and regtests on FC28/x86_64 - OK for trunk and 8-branch?
Paul
2018-09-16 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/85954
* resolve.c (resolve_assoc_var): If the target expression is a
deferred charlen dummy and the associate name shares the
charlen, generate a new one. Make sure that new charlens are in
the namespace list so that they get cleaned up.
* trans-array.c (gfc_is_reallocatable_lhs): Associate names are
not reallocatable.
* trans-decl.c (gfc_get_symbol_decl): Put deferred character
length dummy and result arrays on the deferred initialization
list so that the variable length arrays can be correctly dealt
with.
* trans-expr.c (gfc_conv_string_length): Return if 'expr' is
NULL rather than ICEing..
2018-09-16 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/85954
* gfortran.dg/deferred_character_21.f90 : New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 264288)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8744,8749 ****
--- 8744,8757 ----
if (!sym->ts.u.cl)
sym->ts.u.cl = target->ts.u.cl;
+ if (sym->ts.deferred && target->expr_type == EXPR_VARIABLE
+ && target->symtree->n.sym->attr.dummy
+ && sym->ts.u.cl == target->ts.u.cl)
+ {
+ sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL);
+ sym->ts.deferred = 1;
+ }
+
if (!sym->ts.u.cl->length
&& !sym->ts.deferred
&& target->expr_type == EXPR_CONSTANT)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8756,8762 ****
|| sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
&& target->expr_type != EXPR_VARIABLE)
{
! sym->ts.u.cl = gfc_get_charlen();
sym->ts.deferred = 1;
/* This is reset in trans-stmt.c after the assignment
--- 8764,8770 ----
|| sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
&& target->expr_type != EXPR_VARIABLE)
{
! sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL);
sym->ts.deferred = 1;
/* This is reset in trans-stmt.c after the assignment
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 264288)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_is_reallocatable_lhs (gfc_expr *expr
*** 9520,9525 ****
--- 9520,9528 ----
sym = expr->symtree->n.sym;
+ if (sym->attr.associate_var)
+ return false;
+
/* An allocatable class variable with no reference. */
if (sym->ts.type == BT_CLASS
&& CLASS_DATA (sym)->attr.allocatable
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 264288)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1510,1515 ****
--- 1510,1522 ----
/* Dummy variables should already have been created. */
gcc_assert (sym->backend_decl);
+ /* However, the string length of deferred arrays must be set. */
+ if (sym->ts.type == BT_CHARACTER
+ && sym->ts.deferred
+ && sym->attr.dimension
+ && sym->attr.allocatable)
+ gfc_defer_symbol_init (sym);
+
if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 264288)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_string_length (gfc_charlen * cl
*** 2237,2243 ****
if (!cl->length)
{
gfc_expr* expr_flat;
! gcc_assert (expr);
expr_flat = gfc_copy_expr (expr);
flatten_array_ctors_without_strlen (expr_flat);
gfc_resolve_expr (expr_flat);
--- 2237,2244 ----
if (!cl->length)
{
gfc_expr* expr_flat;
! if (!expr)
! return;
expr_flat = gfc_copy_expr (expr);
flatten_array_ctors_without_strlen (expr_flat);
gfc_resolve_expr (expr_flat);
Index: gcc/testsuite/gfortran.dg/deferred_character_21.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_21.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/deferred_character_21.f90 (working copy)
***************
*** 0 ****
--- 1,29 ----
+ ! { dg-do compile }
+ ! { dg-options "-O3" }
+ !
+ ! Tests the fix for PR85954 in which the gimplifier could not determine
+ ! the space required for the dummy argument data types, when inlining the
+ ! subroutines.
+ !
+ ! Contributed by G.Steinmetz <gs...@t-online.de>
+ !
+ program p
+ character(kind=1,len=:), allocatable :: z(:)
+ allocate (z, source = ["xyz"])
+ print *, allocated(z), size(z), len(z), z
+ call s(z)
+ call t(z)
+ contains
+ subroutine s(x)
+ character(kind=1,len=:), allocatable :: x(:)
+ x = ['abcd']
+ print *, allocated(x), size(x), len(x), x
+ end
+ subroutine t(x)
+ character(kind=1,len=:), allocatable :: x(:)
+ associate (y => x)
+ y = ['abc']
+ end associate
+ print *, allocated(x), size(x), len(x), x
+ end
+ end
