+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
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;
}
}
&& 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);
+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
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'))
--- /dev/null
+! { 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