diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2018-02-17 11:07:32 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2018-02-17 11:07:32 +0000 |
commit | a8399af846a1f9c71f1275f3de74ff3f8a86532a (patch) | |
tree | 0261cf814bb464b35228e498b8b896484764ed07 /gcc/fortran/resolve.c | |
parent | 9f533a82db92db8c0772a0d75e6a76c98ad1bcc9 (diff) | |
download | gcc-a8399af846a1f9c71f1275f3de74ff3f8a86532a.zip gcc-a8399af846a1f9c71f1275f3de74ff3f8a86532a.tar.gz gcc-a8399af846a1f9c71f1275f3de74ff3f8a86532a.tar.bz2 |
re PR fortran/84115 (Failure in associate construct with concatenated character target)
2018-02-17 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-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84115
* gfortran.dg/associate_35.f90: Remove error, add stop n's and
change to run.
From-SVN: r257781
Diffstat (limited to 'gcc/fortran/resolve.c')
-rw-r--r-- | gcc/fortran/resolve.c | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 01e2c38..e1d2aa2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8635,7 +8635,20 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) 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 (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) { |