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/trans-stmt.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/trans-stmt.c')
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 573fd48..71e22d8 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1926,9 +1926,26 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) { gfc_expr *lhs; tree res; + gfc_se se; + + gfc_init_se (&se, NULL); + + /* resolve.c converts some associate names to allocatable so that + allocation can take place automatically in gfc_trans_assignment. + The frontend prevents them from being either allocated, + deallocated or reallocated. */ + if (sym->attr.allocatable) + { + tmp = sym->backend_decl; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_conv_descriptor_data_get (tmp); + gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + } lhs = gfc_lval_expr_from_sym (sym); res = gfc_trans_assignment (lhs, e, false, true); + gfc_add_expr_to_block (&se.pre, res); tmp = sym->backend_decl; if (e->expr_type == EXPR_FUNCTION @@ -1948,8 +1965,25 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) tmp = gfc_deallocate_pdt_comp (CLASS_DATA (sym)->ts.u.derived, tmp, 0); } + else if (sym->attr.allocatable) + { + tmp = sym->backend_decl; + + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_conv_descriptor_data_get (tmp); + + /* A simple call to free suffices here. */ + tmp = gfc_call_free (tmp); + + /* Make sure that reallocation on assignment cannot occur. */ + sym->attr.allocatable = 0; + } + else + tmp = NULL_TREE; + res = gfc_finish_block (&se.pre); gfc_add_init_cleanup (block, res, tmp); + gfc_free_expr (lhs); } /* Set the stringlength, when needed. */ |