From b093d688daa4c6e131007aaa397a55489d5b7ccb Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 1 Oct 2018 14:27:17 +0000 Subject: [PATCH] re PR fortran/65677 (Incomplete assignment on deferred-length character variable) 2018-10-01 Paul Thomas PR fortran/65677 * trans-expr.c (gfc_trans_assignment_1): Set the 'identical' flag in the call to gfc_check_dependency. 2018-10-01 Paul Thomas PR fortran/65677 * gfortran.dg/dependency_52.f90 : Expand the test to check both the call to adjustl and direct assignment of the substring. From-SVN: r264759 --- gcc/fortran/ChangeLog | 8 +++++++- gcc/fortran/dependency.c | 4 ++-- gcc/fortran/trans-expr.c | 4 ++-- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/dependency_52.f90 | 22 +++++++++++++++++---- 5 files changed, 35 insertions(+), 9 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 399d6f9cc3f..d513f2a0c6a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-10-01 Paul Thomas + + PR fortran/65677 + * trans-expr.c (gfc_trans_assignment_1): Set the 'identical' + flag in the call to gfc_check_dependency. + 2018-09-30 Paul Thomas PR fortran/87359 @@ -33,7 +39,7 @@ 2018-09-29 Paul Thomas - PR fortran/65667 + PR fortran/65677 * trans-expr.c (gfc_trans_assignment_1): If there is dependency fix the rse stringlength. diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index a0bbd584947..86359e5967e 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -240,7 +240,7 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok) /* Special case: String arguments which compare equal can have different lengths, which makes them different in calls to procedures. */ - + if (e1->expr_type == EXPR_CONSTANT && e1->ts.type == BT_CHARACTER && e2->expr_type == EXPR_CONSTANT @@ -1907,7 +1907,7 @@ dummy_intent_not_in (gfc_expr **ep) /* Determine if an array ref, usually an array section specifies the entire array. In addition, if the second, pointer argument is provided, the function will return true if the reference is - contiguous; eg. (:, 1) gives true but (1,:) gives false. + contiguous; eg. (:, 1) gives true but (1,:) gives false. If one of the bounds depends on a dummy variable which is not INTENT(IN), also return false, because the user may have changed the variable. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9824848019d..37052b612d4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5281,7 +5281,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* See PR 41453. */ && !e->symtree->n.sym->attr.dummy /* FIXME - PR 87395 and PR 41453 */ - && e->symtree->n.sym->attr.save == SAVE_NONE + && e->symtree->n.sym->attr.save == SAVE_NONE && !e->symtree->n.sym->attr.associate_var && e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED && e->ts.type != BT_CLASS && !sym->attr.elemental; @@ -10208,7 +10208,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, string_length = gfc_evaluate_now (rse.string_length, &rse.pre); else if (expr2->ts.type == BT_CHARACTER) { - if (expr1->ts.deferred && gfc_check_dependency (expr1, expr2, false)) + if (expr1->ts.deferred && gfc_check_dependency (expr1, expr2, true)) rse.string_length = gfc_evaluate_now (rse.string_length, &rse.pre); string_length = rse.string_length; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dced1ea8895..a8ed4780d24 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-10-01 Paul Thomas + + PR fortran/65677 + * gfortran.dg/dependency_52.f90 : Expand the test to check both + the call to adjustl and direct assignment of the substring. + 2018-10-01 Richard Biener PR tree-optimization/87465 diff --git a/gcc/testsuite/gfortran.dg/dependency_52.f90 b/gcc/testsuite/gfortran.dg/dependency_52.f90 index 20c97ca98e5..c176fd99f3e 100644 --- a/gcc/testsuite/gfortran.dg/dependency_52.f90 +++ b/gcc/testsuite/gfortran.dg/dependency_52.f90 @@ -1,6 +1,6 @@ ! { dg-do run } ! -! Test the fix for PR65667, in which the dependency was missed and +! Test the fix for PR65677, in which the dependency was missed and ! the string length of 'text' was decremented twice. The rhs string ! length is now fixed after the function call so that the dependency ! on the length of 'text' is removed for later evaluations. @@ -10,16 +10,21 @@ module mod1 implicit none contains - subroutine getKeyword(string, keyword, rest) + subroutine getKeyword(string, keyword, rest, use_adjustl) character(:), allocatable, intent(IN) :: string character(:), allocatable, intent(OUT) :: keyword, rest integer :: idx character(:), allocatable :: text + logical :: use_adjustl keyword = '' rest = '' text = string - text = ADJUSTL(text(2:)) ! Note dependency. + if (use_adjustl) then + text = ADJUSTL(text(2:)) ! Note dependency. + else + text = text(2:) ! Check the old workaround. + endif idx = INDEX(text, ' ') if (idx == 0) then @@ -38,8 +43,17 @@ end module mod1 line = '@HERE IT IS' - call getKeyword(line, keyword, rest) + call getKeyword(line, keyword, rest, use_adjustl = .true.) if (keyword .ne. 'HERE') stop 1 if (rest .ne. 'IT IS') stop 2 + deallocate (line, keyword, rest) + + line = '@HERE IT IS' + + call getKeyword(line, keyword, rest, use_adjustl = .false.) + + if (keyword .ne. 'HERE') stop 3 + if (rest .ne. 'IT IS') stop 4 + deallocate (line, keyword, rest) end -- 2.30.2