diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 45 |
5 files changed, 73 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6f904b1..c38b34b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2017-10-04 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/60458 + PR fortran/77296 + * resolve.c (resolve_assoc_var): Deferred character type + associate names must not receive an integer conatant length. + * symbol.c (gfc_is_associate_pointer): Deferred character + length functions also require an associate pointer. + * trans-decl.c (gfc_get_symbol_decl): Deferred character + length functions or derived type components require the assoc + name to have variable string length. + * trans-stmt.c (trans_associate_var): Set the string length of + deferred string length associate names. The address expression + is not needed for allocatable, pointer or dummy targets. Change + the comment about defered string length targets. + 2017-10-03 Thomas Koenig <tkoenig@gcc.gnu.org> * io.c (match_wait_element): Correctly match END and EOR tags. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 698cf6d..e6f95d5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8530,7 +8530,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) if (!sym->ts.u.cl) sym->ts.u.cl = target->ts.u.cl; - if (!sym->ts.u.cl->length) + if (!sym->ts.u.cl->length && !sym->ts.deferred) sym->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, target->value.character.length); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 68a76c4..4c109fd 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -5054,6 +5054,12 @@ gfc_is_associate_pointer (gfc_symbol* sym) if (sym->ts.type == BT_CLASS) return true; + if (sym->ts.type == BT_CHARACTER + && sym->ts.deferred + && sym->assoc->target + && sym->assoc->target->expr_type == EXPR_FUNCTION) + return true; + if (!sym->assoc->variable) return false; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index d227d51..b4f515f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1695,6 +1695,14 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (sym->ts.type == BT_CHARACTER) { if (sym->attr.associate_var + && sym->ts.deferred + && sym->assoc && sym->assoc->target + && ((sym->assoc->target->expr_type == EXPR_VARIABLE + && sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER) + || sym->assoc->target->expr_type == EXPR_FUNCTION)) + sym->ts.u.cl->backend_decl = NULL_TREE; + + if (sym->attr.associate_var && sym->ts.u.cl->backend_decl && VAR_P (sym->ts.u.cl->backend_decl)) length = gfc_index_zero_node; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 925ea63..7a76b8e 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1533,6 +1533,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) bool need_len_assign; bool whole_array = true; gfc_ref *ref; + symbol_attribute attr; gcc_assert (sym->assoc); e = sym->assoc->target; @@ -1592,6 +1593,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_conv_expr_descriptor (&se, e); + if (sym->ts.type == BT_CHARACTER + && sym->ts.deferred + && !sym->attr.select_type_temporary + && VAR_P (sym->ts.u.cl->backend_decl) + && se.string_length != sym->ts.u.cl->backend_decl) + { + gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, + fold_convert (gfc_charlen_type_node, + se.string_length)); + } + /* If we didn't already do the pointer assignment, set associate-name descriptor to the one generated for the temporary. */ if ((!sym->assoc->variable && !cst_array_ctor) @@ -1758,8 +1770,35 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) need_len_assign = need_len_assign && sym->ts.type == BT_CHARACTER; } - tmp = TREE_TYPE (sym->backend_decl); - tmp = gfc_build_addr_expr (tmp, se.expr); + if (sym->ts.type == BT_CHARACTER + && sym->ts.deferred + && !sym->attr.select_type_temporary + && VAR_P (sym->ts.u.cl->backend_decl) + && se.string_length != sym->ts.u.cl->backend_decl) + { + gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, + fold_convert (gfc_charlen_type_node, + se.string_length)); + if (e->expr_type == EXPR_FUNCTION) + { + tmp = gfc_call_free (sym->backend_decl); + gfc_add_expr_to_block (&se.post, tmp); + } + } + + attr = gfc_expr_attr (e); + if (sym->ts.type == BT_CHARACTER && e->ts.type == BT_CHARACTER + && (attr.allocatable || attr.pointer || attr.dummy)) + { + /* These are pointer types already. */ + tmp = fold_convert (TREE_TYPE (sym->backend_decl), se.expr); + } + else + { + tmp = TREE_TYPE (sym->backend_decl); + tmp = gfc_build_addr_expr (tmp, se.expr); + } + gfc_add_modify (&se.pre, sym->backend_decl, tmp); gfc_add_init_cleanup (block, gfc_finish_block( &se.pre), @@ -1784,7 +1823,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_init_se (&se, NULL); if (e->symtree->n.sym->ts.type == BT_CHARACTER) { - /* What about deferred strings? */ + /* Deferred strings are dealt with in the preceeding. */ gcc_assert (!e->symtree->n.sym->ts.deferred); tmp = e->symtree->n.sym->ts.u.cl->backend_decl; } |