From 5c60dbc14b42430d8bcf1d347d3fc655d242b84e Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 19 Feb 2018 22:09:13 +0000 Subject: [PATCH] re PR fortran/83344 (Use of uninitialized memory with ASSOCIATE and strings) 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. From-SVN: r257827 --- gcc/fortran/ChangeLog | 14 ++++++++ gcc/fortran/resolve.c | 38 ++++++++++------------ gcc/fortran/trans-decl.c | 5 +-- gcc/testsuite/ChangeLog | 7 ++++ gcc/testsuite/gfortran.dg/associate_22.f90 | 9 +++-- gcc/testsuite/gfortran.dg/associate_36.f90 | 28 ++++++++++++++++ 6 files changed, 73 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associate_36.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 32646ebf8f7..e3818ab6a92 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +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 Thomas Koenig PR fortran/35339 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; } } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 51de933e82d..a50c50da206 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1707,12 +1707,13 @@ gfc_get_symbol_decl (gfc_symbol * sym) && 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->assoc->target->expr_type != EXPR_VARIABLE)) 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)) + && (VAR_P (sym->ts.u.cl->backend_decl) + || TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)) length = gfc_index_zero_node; else length = gfc_create_string_length (sym); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 286a6af5a4b..531d29ad4cf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +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. + 2018-02-19 Jakub Jelinek PR target/84146 diff --git a/gcc/testsuite/gfortran.dg/associate_22.f90 b/gcc/testsuite/gfortran.dg/associate_22.f90 index 2e2fb58cdba..35daf89098d 100644 --- a/gcc/testsuite/gfortran.dg/associate_22.f90 +++ b/gcc/testsuite/gfortran.dg/associate_22.f90 @@ -24,11 +24,10 @@ program foo end associate ! This failed. - ! This still doesn't work correctly, see PR 83344 -! a = trim(s) // 'abc' -! associate(w => trim(s) // 'abc') -! if (trim(w) /= trim(a)) STOP 4 -! end associate + a = trim(s) // 'abc' + associate(w => trim(s) // 'abc') + if (trim(w) /= trim(a)) STOP 4 + end associate ! This failed. associate(x => trim('abc')) diff --git a/gcc/testsuite/gfortran.dg/associate_36.f90 b/gcc/testsuite/gfortran.dg/associate_36.f90 new file mode 100644 index 00000000000..ba236b431aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_36.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! +! Test the fix for PR83344. +! +! Contributed by +! +program foo + implicit none + character(len=1) a + character(len=2) b + character(len=3) c + a = 'a' + call bah(a, len (a)) + b = 'bb' + call bah(b, len (b)) + c = 'ccc' + call bah(c, len (c)) + contains + subroutine bah(x, clen) + implicit none + integer :: clen + character(len=*), intent(in) :: x + associate(y => x) + if (len(y) .ne. clen) stop 1 + if (y .ne. x) stop 2 + end associate + end subroutine bah +end program foo -- 2.30.2