Fortran: Fix problems with substring selectors in ASSOCIATE [PR115700]

2024-11-01  Paul Thomas  <pault@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.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 8045deddd8ade87600bf0a0703237f920ce37669..b14d3e776ab700e893dc2735ec229f5f2c57b3e6 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9883,10 +9883,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 28f488bb2746c07db9991d536fe1c357dcadf5b2..35db417867d4c4a13cbe41330662df49a22c852e 100644 (file)
--- 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 b8916f4c70fd718abc803c0407980ae7edaa56bd..ddb38b84c4b3672c787a378c558422c3b3987ac5 100644 (file)
--- 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  <anlauf@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