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:
parent
00b9448735
commit
5c60dbc14b
@ -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
|
||||
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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'))
|
||||
|
28
gcc/testsuite/gfortran.dg/associate_36.f90
Normal file
28
gcc/testsuite/gfortran.dg/associate_36.f90
Normal 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
|
Loading…
Reference in New Issue
Block a user