https://gcc.gnu.org/g:50139164b162c968d1e46b4c4a80bd815a00a5da
commit r13-9189-g50139164b162c968d1e46b4c4a80bd815a00a5da
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Fri Nov 1 07:45:00 2024 +0000
Fortran: Fix problems with substring selectors in ASSOCIATE [PR115700]
2024-11-01 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/115700
* resolve.cc (resolve_assoc_var): Extract a substring reference
with missing as well as non-constant start or end.
gcc/testsuite/
PR fortran/115700
* gfortran.dg/associate_69.f90: Activate commented out tests.
* gfortran.dg/associate_70.f90: Test correct functioning of
references in associate_69.f90 tests.
(cherry picked from commit 7f93910a8b5d606ad742a3594750f0c2b20d8bda)
Diff:
---
gcc/fortran/resolve.cc | 8 ++---
gcc/testsuite/gfortran.dg/associate_69.f90 | 23 +++++++++-----
gcc/testsuite/gfortran.dg/associate_70.f90 | 50 +++++++++++++++++++++---------
3 files changed, 54 insertions(+), 27 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 3a1f79c674fa..adfde61bbdb1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9399,10 +9399,10 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
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)))
+ && (ref->u.ss.start == NULL
+ || ref->u.ss.start->expr_type != EXPR_CONSTANT
+ || ref->u.ss.end == NULL
+ || ref->u.ss.end->expr_type != EXPR_CONSTANT))
break;
if (!sym->ts.u.cl)
diff --git a/gcc/testsuite/gfortran.dg/associate_69.f90
b/gcc/testsuite/gfortran.dg/associate_69.f90
index 28f488bb2746..35db417867d4 100644
--- a/gcc/testsuite/gfortran.dg/associate_69.f90
+++ b/gcc/testsuite/gfortran.dg/associate_69.f90
@@ -2,10 +2,14 @@
! { dg-options "-Og -Wuninitialized -Wmaybe-uninitialized
-fdump-tree-optimized" }
!
! PR fortran/115700 - Bogus warning for associate with assumed-length
character array
+! This testcase checks for the suppression of the bogus error and associate_70
for
+! correct results.
!
subroutine mvce(x)
implicit none
character(len=*), dimension(:), intent(in) :: x
+ integer :: i
+ i = len(x)
associate (tmp1 => x)
if (len (tmp1) /= len (x)) stop 1
@@ -19,15 +23,18 @@ subroutine mvce(x)
if (len (tmp3) /= len (x)) stop 3
end associate
-! The following associate blocks still produce bogus warnings:
+ associate (tmp4 => x(:)(1:))
+ if (len (tmp4) /= len (x)) stop 4
+ end associate
-! associate (tmp4 => x(:)(1:))
-! if (len (tmp4) /= len (x)) stop 4
-! end associate
-!
-! associate (tmp5 => x(1:)(1:))
-! if (len (tmp5) /= len (x)) stop 5
-! end associate
+ associate (tmp5 => x(1:)(1:))
+ if (len (tmp5) /= len (x)) stop 5
+ end associate
+
+ associate (temp6 => x(:)(1:i/2))
+ if (len (temp6) /= i/2) stop 6
+ end associate
end
! { dg-final { scan-tree-dump-not " \\.tmp" "optimized" } }
+! { dg-final { scan-tree-dump-times " \\.temp6" 7 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/associate_70.f90
b/gcc/testsuite/gfortran.dg/associate_70.f90
index b8916f4c70fd..ddb38b84c4b3 100644
--- a/gcc/testsuite/gfortran.dg/associate_70.f90
+++ b/gcc/testsuite/gfortran.dg/associate_70.f90
@@ -3,37 +3,57 @@
!
! Test fix for PR115700 comment 5, in which ‘.tmp1’ is used uninitialized and
! both normal and scalarized array references did not work correctly.
+! This testcase checks for correct results and associate_69 for suppression
+! of the bogus error.
!
! 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
+ character(len=*), dimension(:), intent(inOUT) :: 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']
+ associate (tmp1 => x)
+ if (len (tmp1) /= len (x)) stop 2
+ tmp1(2)(3:4) = '12'
+ end associate
+ if (any (x /= ['abcd', 'ef12', 'ijkl'])) stop 3
+
+ associate (tmp2 => x(1:))
+ if (len (tmp2) /= len (x)) stop 4
+ tmp2(2)(1:2) = '34'
+ end associate
+ if (any (x /= ['abcd', '3412', 'ijkl'])) stop 5
+
+ associate (tmp3 => x(1:)(:))
+ if (len (tmp3) /= len (x)) stop 6
+ tmp3(3)(3:4) = '56'
+ end associate
+ if (any (x /= ['abcd', '3412', 'ij56'])) stop 7
+
+ associate (tmp4 => x(:)(1:))
+ if (len (tmp4) /= len (x)) stop 8
+ tmp4(3)(1:2) = '78'
end associate
+ if (any (x /= ['abcd', '3412', '7856'])) stop 9
-! 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
+ associate (tmp5 => x(1:)(1:))
+ if (len (tmp5) /= len (x)) stop 10
+ tmp5 = ['abcd', 'efgh', 'ijkl']
end associate
+ if (any (x /= ['abcd', 'efgh', 'ijkl'])) stop 11
- associate (tmp3 => x(3)(1:i/2))
- if (len (tmp3) /= i/2) stop 8
- if (tmp3 /= 'IJ') stop 9
+ associate (tmp6 => x(:)(1:i/2))
+ if (len (tmp6) /= i/2) stop 11
+ if (tmp6(2) /= 'ef') stop 12
+ if (any (tmp6 /= ['ab', 'ef', 'ij'])) stop 13
+ tmp6 = ['AB','EF','IJ']
end associate
end subroutine mvce
