From aa53a3f7fba14b04b0ec251a1fa62290d0b4f8ac Mon Sep 17 00:00:00 2001 From: pault Date: Sat, 17 Feb 2018 11:07:32 +0000 Subject: 2018-02-17 Paul Thomas 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 PR fortran/84115 * gfortran.dg/associate_35.f90: Remove error, add stop n's and change to run. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257781 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/resolve.c | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 01e2c38952c..e1d2aa27ad1 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) { -- cgit v1.2.1 From ef718f2c199e9bf64602c621a432378986da0815 Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 19 Feb 2018 22:09:13 +0000 Subject: 2018-02-19 Paul Thomas PR fortran/83344 PR fortran/83975 * resolve.c (resolve_assoc_var): Rearrange the logic for the determination of the character length of associate names. If the associate name is missing a length expression or the length expression is not a constant and the target is not a variable, make the associate name allocatable and deferred length. * trans-decl.c (gfc_get_symbol_decl): Null the character length backend_decl for deferred length associate names that are not variables. Set 'length' to gfc_index_zero_node for character associate names, whose character length is a PARM_DECL. 2018-02-19 Paul Thomas PR fortran/83344 PR fortran/83975 * gfortran.dg/associate_22.f90: Enable commented out test. * gfortran.dg/associate_36.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257827 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/resolve.c | 38 +++++++++++++++++--------------------- 1 file changed, 17 insertions(+), 21 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e1d2aa27ad1..fee5b1becf5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8635,30 +8635,26 @@ 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) - { - if (target->expr_type != EXPR_CONSTANT - && !target->ts.u.cl->length) - { - sym->ts.u.cl = gfc_get_charlen(); - sym->ts.deferred = 1; + sym->ts.u.cl = target->ts.u.cl; - /* 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 + && target->expr_type == EXPR_CONSTANT) + { + sym->ts.u.cl->length = + gfc_get_int_expr (gfc_charlen_int_kind, NULL, + target->value.character.length); } - - if (!sym->ts.u.cl->length && !sym->ts.deferred) + else if ((!sym->ts.u.cl->length + || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT) + && target->expr_type != EXPR_VARIABLE) { - if (target->expr_type == EXPR_CONSTANT) - sym->ts.u.cl->length = - gfc_get_int_expr (gfc_charlen_int_kind, NULL, - target->value.character.length); - else - gfc_error ("Not Implemented: Associate target with type character" - " and non-constant length at %L", &target->where); + 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; } } -- cgit v1.2.1