re PR fortran/84115 (Failure in associate construct with concatenated character target)

2018-02-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84115
	* trans-decl.c (gfc_get_symbol_decl): Do not finish the decl of
	'length' if the symbol charlen backend_decl is an indirect ref.

2018-02-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84115
	* gfortran.dg/associate_34.f90: New test.
	* gfortran.dg/associate_35.f90: New test.

From-SVN: r257363

5 files changed, 70 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index da86c83..4095c01 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2018-02-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84115
+	* trans-decl.c (gfc_get_symbol_decl): Do not finish the decl of
+	'length' if the symbol charlen backend_decl is an indirect ref.
+
 2018-02-03  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/84141
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 9b0b2a1..4fc07b6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1774,7 +1774,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Associate names can use the hidden string length variable
      of their associated target.  */
   if (sym->ts.type == BT_CHARACTER
-      && TREE_CODE (length) != INTEGER_CST)
+      && TREE_CODE (length) != INTEGER_CST
+      && TREE_CODE (sym->ts.u.cl->backend_decl) != INDIRECT_REF)
     {
       gfc_finish_var_decl (length, sym);
       gcc_assert (!sym->value);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1c34494..3c93cba 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-02-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84115
+	* gfortran.dg/associate_34.f90: New test.
+	* gfortran.dg/associate_35.f90: New test.
+
 2018-02-03  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/84141
diff --git a/gcc/testsuite/gfortran.dg/associate_34.f90 b/gcc/testsuite/gfortran.dg/associate_34.f90
new file mode 100644
index 0000000..629c0b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_34.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+! Test the fix for PR84115.
+!
+! Contributed by G Steinmetz  <gscfq@t-online.de>
+!
+  character(:), allocatable :: chr
+  allocate (chr, source = "abc")
+  call s(chr, "abc")
+  chr = "mary had a little lamb"
+  call s(chr, "mary had a little lamb")
+  deallocate (chr)
+contains
+  subroutine s(x, carg)
+    character(:), allocatable :: x
+    character(*) :: carg
+    associate (y => x)
+      if (y .ne. carg) call abort
+    end associate
+  end
+end
diff --git a/gcc/testsuite/gfortran.dg/associate_35.f90 b/gcc/testsuite/gfortran.dg/associate_35.f90
new file mode 100644
index 0000000..417ec7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_35.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! Test the fix for PR84115 comment #1 (except for s1(x)!).
+!
+! Contributed by G Steinmetz  <gscfq@t-online.de>
+!
+  character(:), allocatable :: dum
+  dum = "s1"
+  call s1 (dum)
+  dum = "s2"
+  call s2 (dum)
+  dum = "s3"
+  call s3 (dum)
+contains
+  subroutine s1(x)
+    character(:), allocatable :: x
+    associate (y => x//x)   ! { dg-error "type character and non-constant length" }
+      print *, y
+    end associate
+  end
+
+  subroutine s2(x)
+    character(:), allocatable :: x
+    associate (y => [x])
+      print *, y
+    end associate
+  end
+
+  subroutine s3(x)
+    character(:), allocatable :: x
+    associate (y => [x,x])
+      print *, y
+    end associate
+  end
+end