Commit b093d688 by Paul Thomas

re PR fortran/65677 (Incomplete assignment on deferred-length character variable)

2018-10-01  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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
parent fd5c626c
2018-10-01 Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org> 2018-09-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/87359 PR fortran/87359
...@@ -33,7 +39,7 @@ ...@@ -33,7 +39,7 @@
2018-09-29 Paul Thomas <pault@gcc.gnu.org> 2018-09-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/65667 PR fortran/65677
* trans-expr.c (gfc_trans_assignment_1): If there is dependency * trans-expr.c (gfc_trans_assignment_1): If there is dependency
fix the rse stringlength. fix the rse stringlength.
......
...@@ -240,7 +240,7 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok) ...@@ -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 /* Special case: String arguments which compare equal can have
different lengths, which makes them different in calls to different lengths, which makes them different in calls to
procedures. */ procedures. */
if (e1->expr_type == EXPR_CONSTANT if (e1->expr_type == EXPR_CONSTANT
&& e1->ts.type == BT_CHARACTER && e1->ts.type == BT_CHARACTER
&& e2->expr_type == EXPR_CONSTANT && e2->expr_type == EXPR_CONSTANT
...@@ -1907,7 +1907,7 @@ dummy_intent_not_in (gfc_expr **ep) ...@@ -1907,7 +1907,7 @@ dummy_intent_not_in (gfc_expr **ep)
/* Determine if an array ref, usually an array section specifies the /* Determine if an array ref, usually an array section specifies the
entire array. In addition, if the second, pointer argument is entire array. In addition, if the second, pointer argument is
provided, the function will return true if the reference 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 If one of the bounds depends on a dummy variable which is
not INTENT(IN), also return false, because the user may not INTENT(IN), also return false, because the user may
have changed the variable. */ have changed the variable. */
......
...@@ -5281,7 +5281,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -5281,7 +5281,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* See PR 41453. */ /* See PR 41453. */
&& !e->symtree->n.sym->attr.dummy && !e->symtree->n.sym->attr.dummy
/* FIXME - PR 87395 and PR 41453 */ /* 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->symtree->n.sym->attr.associate_var
&& e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED && e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED
&& e->ts.type != BT_CLASS && !sym->attr.elemental; && 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, ...@@ -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); string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
else if (expr2->ts.type == BT_CHARACTER) 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); rse.string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
string_length = rse.string_length; string_length = rse.string_length;
} }
......
2018-10-01 Paul Thomas <pault@gcc.gnu.org>
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 <rguenther@suse.de> 2018-10-01 Richard Biener <rguenther@suse.de>
PR tree-optimization/87465 PR tree-optimization/87465
......
! { dg-do run } ! { 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 ! the string length of 'text' was decremented twice. The rhs string
! length is now fixed after the function call so that the dependency ! length is now fixed after the function call so that the dependency
! on the length of 'text' is removed for later evaluations. ! on the length of 'text' is removed for later evaluations.
...@@ -10,16 +10,21 @@ ...@@ -10,16 +10,21 @@
module mod1 module mod1
implicit none implicit none
contains contains
subroutine getKeyword(string, keyword, rest) subroutine getKeyword(string, keyword, rest, use_adjustl)
character(:), allocatable, intent(IN) :: string character(:), allocatable, intent(IN) :: string
character(:), allocatable, intent(OUT) :: keyword, rest character(:), allocatable, intent(OUT) :: keyword, rest
integer :: idx integer :: idx
character(:), allocatable :: text character(:), allocatable :: text
logical :: use_adjustl
keyword = '' keyword = ''
rest = '' rest = ''
text = string 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, ' ') idx = INDEX(text, ' ')
if (idx == 0) then if (idx == 0) then
...@@ -38,8 +43,17 @@ end module mod1 ...@@ -38,8 +43,17 @@ end module mod1
line = '@HERE IT IS' line = '@HERE IT IS'
call getKeyword(line, keyword, rest) call getKeyword(line, keyword, rest, use_adjustl = .true.)
if (keyword .ne. 'HERE') stop 1 if (keyword .ne. 'HERE') stop 1
if (rest .ne. 'IT IS') stop 2 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 end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment