Hi Janne, Please find attached a revised version of the patch that fixes all the issues that I know of.
Regtests on FC27/x86_64 - OK for trunk? I have also attached a test of all the failing cases in PR83975. However, I believe that they are all included in other associate*.f*. Cheers Paul 2018-02-19 Paul Thomas <pa...@gcc.gnu.org> PR fortran/83344 * 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 <pa...@gcc.gnu.org> PR fortran/83344 * gfortran.dg/associate_22.f90: Enable commented out test. * gfortran.dg/associate_36.f90: New test. On 18 February 2018 at 21:01, Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote: > Hi Janne and Thomas, > > 1) The patch is attached now - sorry! > > 2) The commented out part of associate_22.f90 is not yet fixed. I am > working on it. > > 3) I will take a look at PR83975 tomorrow night. > > Paul > > > On 18 February 2018 at 16:08, Janne Blomqvist <blomqvist.ja...@gmail.com> > wrote: >> On Sun, Feb 18, 2018 at 5:48 PM, Paul Richard Thomas >> <paul.richard.tho...@gmail.com> wrote: >>> Bootstraps and regtests on FC27/x86_64 - OK for trunk? >> >> Hi, >> >> thanks for looking into this! >> >> 1. The patch itself is missing... >> >> 2. Could you uncomment the commented out part of associate_22.f90 and >> check that the tree-original dump is sensible. >> >> 3. Same for the testcases posted to PR 83975. I suspect (err, hope) >> that this patch would fix those as well. If so, please add that PR to >> the ChangeLog entries as well. >> >>> >>> Paul >>> >>> 2018-02-18 Paul Thomas <pa...@gcc.gnu.org> >>> >>> PR fortran/83344 >>> * resolve.c (resolve_assoc_var): Character associate names that >>> have no length expression that have variable targets and are >>> not deferred length have assumed length. >>> * trans-decl.c (gfc_get_symbol_decl): Set 'length' to >>> gfc_index_zero_node for character associate names, whose string >>> length is a PARM_DECL. >>> >>> 2018-02-18 Paul Thomas <pa...@gcc.gnu.org> >>> >>> PR fortran/83344 >>> * gfortran.dg/associate_36.f90: New test. >> >> >> >> -- >> Janne Blomqvist > > > > -- > "If you can't explain it simply, you don't understand it well enough" > - Albert Einstein -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein
Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (revision 257787) --- gcc/fortran/resolve.c (working copy) *************** resolve_assoc_var (gfc_symbol* sym, bool *** 8635,8664 **** 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; ! /* 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) { ! 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); } } --- 8635,8660 ---- 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 (!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); } ! else if ((!sym->ts.u.cl->length ! || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT) ! && target->expr_type != EXPR_VARIABLE) { ! 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; } } Index: gcc/fortran/trans-decl.c =================================================================== *** gcc/fortran/trans-decl.c (revision 257787) --- gcc/fortran/trans-decl.c (working copy) *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 1707,1718 **** && 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; else length = gfc_create_string_length (sym); --- 1707,1719 ---- && 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_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) ! || TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)) length = gfc_index_zero_node; else length = gfc_create_string_length (sym); Index: gcc/testsuite/gfortran.dg/associate_22.f90 =================================================================== *** gcc/testsuite/gfortran.dg/associate_22.f90 (revision 257787) --- gcc/testsuite/gfortran.dg/associate_22.f90 (working copy) *************** program foo *** 24,34 **** 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 ! This failed. associate(x => trim('abc')) --- 24,33 ---- end associate ! This failed. ! a = trim(s) // 'abc' ! associate(w => trim(s) // 'abc') ! if (trim(w) /= trim(a)) STOP 4 ! end associate ! This failed. associate(x => trim('abc')) Index: gcc/testsuite/gfortran.dg/associate_36.f90 =================================================================== *** gcc/testsuite/gfortran.dg/associate_36.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/associate_36.f90 (working copy) *************** *** 0 **** --- 1,28 ---- + ! { dg-do run } + ! + ! Test the fix for PR83344. + ! + ! Contributed by <Janne Blomqvist <j...@gcc.gnu.org> + ! + 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
! { dg-do run } ! ! Checks that all the tests in PR83975 now work. ! ! Contributed by G Steinmetz <gs...@t-online.de> ! character(10) :: chr = "abcdefghij" call s1(chr) call s2(chr) call s3(chr) call s4(chr) call s5(chr) contains subroutine s1(x) character(*) :: x associate (y => x) if (y .ne. "abcdefghij") stop 1 y = "xyz end" end associate end subroutine s2(x) character(*) :: x associate (y => [x]) if (y(1) .ne. "xyz end") stop 2 end associate end subroutine s3(x) character(*) :: x associate (y => [x, x]) if (any (y .ne. ["xyz end","xyz end"])) stop 3 end associate end subroutine s4(x) character(*) :: x associate (y => x) y = "abc end" if (y .ne. "abc end") stop 4 end associate end subroutine s5(x) character(*) :: x associate (y => x//x) if (y .ne. "abc endabc end") stop 5 end associate end end