Fortran: fix associate with assumed-length character array [PR115700]

gcc/fortran/ChangeLog:

	PR fortran/115700
	* trans-stmt.cc (trans_associate_var): When the associate target
	is an array-valued character variable, the length is known at entry
	of the associate block.  Move setting of string length of the
	selector to the initialization part of the block.

gcc/testsuite/ChangeLog:

	PR fortran/115700
	* gfortran.dg/associate_69.f90: New test.

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 60275e18867692fef755251e6c37fc7b907309b4..703a705e7caf89e6f2fe071491588a8e28bddc22 100644 (file)
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1911,6 +1911,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       gfc_se se;
       tree desc;
       bool cst_array_ctor;
+      stmtblock_t init;
+      gfc_init_block (&init);
 
       desc = sym->backend_decl;
       cst_array_ctor = e->expr_type == EXPR_ARRAY
@@ -1935,10 +1937,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
          && !sym->attr.select_type_temporary
          && sym->ts.u.cl->backend_decl
          && VAR_P (sym->ts.u.cl->backend_decl)
+         && se.string_length
          && se.string_length != sym->ts.u.cl->backend_decl)
-       gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
-                         fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
-                                       se.string_length));
+       {
+         /* When the target is a variable, its length is already known.  */
+         tree len = fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
+                                  se.string_length);
+         if (e->expr_type == EXPR_VARIABLE)
+           gfc_add_modify (&init, sym->ts.u.cl->backend_decl, len);
+         else
+           gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, len);
+       }
 
       /* If we didn't already do the pointer assignment, set associate-name
         descriptor to the one generated for the temporary.  */
@@ -1978,7 +1987,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
        }
 
       /* Done, register stuff as init / cleanup code.  */
-      gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
+      gfc_add_block_to_block (&init, &se.pre);
+      gfc_add_init_cleanup (block, gfc_finish_block (&init),
                            gfc_finish_block (&se.post));
     }
 

diff --git a/gcc/testsuite/gfortran.dg/associate_69.f90 b/gcc/testsuite/gfortran.dg/associate_69.f90
new file mode 100644 (file)
index 0000000..28f488b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_69.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-Og -Wuninitialized -Wmaybe-uninitialized -fdump-tree-optimized" }
+!
+! PR fortran/115700 - Bogus warning for associate with assumed-length character array
+!
+subroutine mvce(x)
+  implicit none
+  character(len=*), dimension(:), intent(in)  :: x
+
+  associate (tmp1 => x)
+    if (len (tmp1) /= len (x)) stop 1
+  end associate
+
+  associate (tmp2 => x(1:))
+    if (len (tmp2) /= len (x)) stop 2
+  end associate
+
+  associate (tmp3 => x(1:)(:))
+    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 (tmp5 => x(1:)(1:))
+!   if (len (tmp5) /= len (x)) stop 5
+! end associate
+end
+
+! { dg-final { scan-tree-dump-not " \\.tmp" "optimized" } }