re PR fortran/83344 (Use of uninitialized memory with ASSOCIATE and strings)

2018-02-19  Paul Thomas  <pault@gcc.gnu.org>

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

	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
This commit is contained in:
Paul Thomas 2018-02-19 22:09:13 +00:00
parent 00b9448735
commit 5c60dbc14b
6 changed files with 73 additions and 28 deletions

View File

@ -1,3 +1,17 @@
2018-02-19 Paul Thomas <pault@gcc.gnu.org>
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 <tkoenig@gcc.gnu.org>
PR fortran/35339

View File

@ -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;
}
}

View File

@ -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);

View File

@ -1,3 +1,10 @@
2018-02-19 Paul Thomas <pault@gcc.gnu.org>
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 <jakub@redhat.com>
PR target/84146

View File

@ -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'))

View File

@ -0,0 +1,28 @@
! { dg-do run }
!
! Test the fix for PR83344.
!
! Contributed by <Janne Blomqvist <jb@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