This wrinkle to PR115700 came about because the associate-name string length was not being initialized, when an array selector had a substring reference with non-constant start or end. This, of course, caused subsequent references to fail.
The ChangeLog provides an adequate explanation of the attached patch. OK for mainline and backporting to 14-branch? Paul
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 565d4aa5fe9..8045deddd8a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6153,6 +6153,15 @@ resolve_variable (gfc_expr *e)
e->ref = newref;
}
}
+ else if (sym->assoc && sym->ts.type == BT_CHARACTER && sym->ts.deferred)
+ {
+ gfc_ref *ref;
+ for (ref = e->ref; ref; ref = ref->next)
+ if (ref->type == REF_SUBSTRING)
+ break;
+ if (ref == NULL)
+ e->ts = sym->ts;
+ }
if (e->ref && !gfc_resolve_ref (e))
return false;
@@ -9871,6 +9880,15 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
/* Fix up the type-spec for CHARACTER types. */
if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
{
+ gfc_ref *ref;
+ for (ref = target->ref; ref; ref = ref->next)
+ if (ref->type == REF_SUBSTRING
+ && ((ref->u.ss.start
+ && ref->u.ss.start->expr_type != EXPR_CONSTANT)
+ || (ref->u.ss.end
+ && ref->u.ss.end->expr_type != EXPR_CONSTANT)))
+ break;
+
if (!sym->ts.u.cl)
sym->ts.u.cl = target->ts.u.cl;
@@ -9889,9 +9907,10 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
gfc_get_int_expr (gfc_charlen_int_kind, NULL,
target->value.character.length);
}
- else if ((!sym->ts.u.cl->length
- || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+ else if (((!sym->ts.u.cl->length
+ || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
&& target->expr_type != EXPR_VARIABLE)
+ || ref)
{
if (!sym->ts.deferred)
{
@@ -9901,7 +9920,10 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
/* This is reset in trans-stmt.cc after the assignment
of the target expression to the associate name. */
- sym->attr.allocatable = 1;
+ if (ref && sym->as)
+ sym->attr.pointer = 1;
+ else
+ sym->attr.allocatable = 1;
}
}
@@ -11508,8 +11530,9 @@ resolve_block_construct (gfc_code* code)
{
gfc_namespace *ns = code->ext.block.ns;
- /* For an ASSOCIATE block, the associations (and their targets) are already
- resolved during resolve_symbol. Resolve the BLOCK's namespace. */
+ /* For an ASSOCIATE block, the associations (and their targets) will be
+ resolved by gfc_resolve_symbol, during resolution of the BLOCK's
+ namespace. */
gfc_resolve (ns);
}
diff --git a/gcc/testsuite/gfortran.dg/associate_70.f90 b/gcc/testsuite/gfortran.dg/associate_70.f90
new file mode 100644
index 00000000000..397754c0b52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_70.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! ( dg-options "-Wuninitialized" )
+!
+! Test fix for PR115700 comment 5, in which ‘.tmp4’ is used uninitialized and
+! both normal and scalarized array references did not work correctly.
+!
+! Contributed by Harald Anlauf <anl...@gcc.gnu.org>
+!
+ character(4), dimension(3) :: chr = ['abcd', 'efgh', 'ijkl']
+ call mvce (chr)
+ if (any (chr /= ['ABcd', 'EFgh', 'IJkl'])) stop 1
+contains
+ subroutine mvce(x)
+ implicit none
+ character(len=*), dimension(:), intent(inOUT), target :: x
+ integer :: i
+ i = len(x)
+
+! This was broken
+ associate (tmp1 => x(:)(1:i/2))
+ if (len (tmp1) /= i/2) stop 2
+ if (tmp1(2) /= 'ef') stop 3
+ if (any (tmp1 /= ['ab', 'ef', 'ij'])) stop 4
+ tmp1 = ['AB','EF','IJ']
+ end associate
+
+! Retest things that worked previously.
+ associate (tmp2 => x(:)(1:2))
+ if (len (tmp2) /= i/2) stop 5
+ if (tmp2(2) /= 'EF') stop 6
+ if (any (tmp2 /= ['AB','EF','IJ'])) stop 7
+ end associate
+
+ associate (tmp3 => x(3)(1:i/2))
+ if (len (tmp3) /= i/2) stop 8
+ if (tmp3 /= 'IJ') stop 9
+ end associate
+
+ end subroutine mvce
+end
Change.Logs
Description: Binary data
