https://gcc.gnu.org/g:caa2b2038dadcb545f825d5c736cc50d90245bbc
commit r14-10927-gcaa2b2038dadcb545f825d5c736cc50d90245bbc
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Thu Oct 31 07:22:36 2024 +0000
Fortran: Fix problem with substring selectors in ASSOCIATE [PR115700]
2024-10-31 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/115700
* resolve.cc (resolve_variable): The typespec of an expression,
which is not a substring, can be shared with a deferred length
associate name.
(resolve_assoc_var): Extract a substring reference with non-
constant start or end. Use it to flag up the need for array
associate name to be a pointer.
(resolve_block_construct): Change comment from past to future
tense.
gcc/testsuite/
PR fortran/115700
* gfortran.dg/associate_70.f90: New test.
(cherry picked from commit 159fb203231c503418e7ab9f45282957e40cb195)
Diff:
---
gcc/fortran/resolve.cc | 33 ++++++++++++++++++++----
gcc/testsuite/gfortran.dg/associate_70.f90 | 40 ++++++++++++++++++++++++++++++
2 files changed, 68 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d7a0856fcca1..50427f7450b4 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6011,6 +6011,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;
@@ -9676,6 +9685,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;
@@ -9694,9 +9712,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)
{
@@ -9706,7 +9725,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;
}
}
@@ -11290,8 +11312,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 000000000000..b8916f4c70fd
--- /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 ‘.tmp1’ 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
