re PR fortran/60334 (Segmentation fault on character pointer assignments)

2015-01-17  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/60334
	* trans-decl.c (gfc_get_symbol_decl):Use a ref on the string
	length when the symbol is declared to be a result.
	* trans-expr.c (gfc_conv_procedure_call): Strip deref on the
	string length when functions are nested and the string length
	is a reference already.

2015-01-17  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/60334
	* gfortran.dg/deferred_type_param_6.f90: Add tests for this PR.

From-SVN: r219798

5 files changed, 70 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c97de7f..eb02d88 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2015-01-17  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/60334
+	* trans-decl.c (gfc_get_symbol_decl):Use a ref on the string
+	length when the symbol is declared to be a result.
+	* trans-expr.c (gfc_conv_procedure_call): Strip deref on the
+	string length when functions are nested and the string length
+	is a reference already.
+
 2015-01-16  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/45290
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cad9b5b..a73620f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1370,12 +1370,30 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	     (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl))
 	    sym->ts.u.cl->backend_decl = NULL_TREE;
 
-	  if (sym->ts.deferred && fun_or_res
-		&& sym->ts.u.cl->passed_length == NULL
-		&& sym->ts.u.cl->backend_decl)
+	  if (sym->ts.deferred && byref)
 	    {
-	      sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
-	      sym->ts.u.cl->backend_decl = NULL_TREE;
+	      /* The string length of a deferred char array is stored in the
+		 parameter at sym->ts.u.cl->backend_decl as a reference and
+		 marked as a result.  Exempt this variable from generating a
+		 temporary for it.  */
+	      if (sym->attr.result)
+		{
+		  /* We need to insert a indirect ref for param decls.  */
+		  if (sym->ts.u.cl->backend_decl
+		      && TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
+		    sym->ts.u.cl->backend_decl =
+			build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
+		}
+	      /* For all other parameters make sure, that they are copied so
+		 that the value and any modifications are local to the routine
+		 by generating a temporary variable.  */
+	      else if (sym->attr.function
+		       && sym->ts.u.cl->passed_length == NULL
+		       && sym->ts.u.cl->backend_decl)
+		{
+		  sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
+		  sym->ts.u.cl->backend_decl = NULL_TREE;
+		}
 	    }
 
 	  if (sym->ts.u.cl->backend_decl == NULL_TREE)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5ebf3abb..420d6ad 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5010,10 +5010,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	 so that the value can be returned.  */
       if (parmse.string_length && fsym && fsym->ts.deferred)
 	{
-	  tmp = parmse.string_length;
-	  if (TREE_CODE (tmp) != VAR_DECL)
-	    tmp = gfc_evaluate_now (parmse.string_length, &se->pre);
-	  parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp);
+	  if (INDIRECT_REF_P (parmse.string_length))
+	    /* In chains of functions/procedure calls the string_length already
+	       is a pointer to the variable holding the length.  Therefore
+	       remove the deref on call.  */
+	    parmse.string_length = TREE_OPERAND (parmse.string_length, 0);
+	  else
+	    {
+	      tmp = parmse.string_length;
+	      if (TREE_CODE (tmp) != VAR_DECL)
+		tmp = gfc_evaluate_now (parmse.string_length, &se->pre);
+	      parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp);
+	    }
 	}
 
       /* Character strings are passed as two parameters, a length and a
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3d424ce..dcebc53 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-17  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/60334
+	* gfortran.dg/deferred_type_param_6.f90: Add tests for this PR.
+
 2015-01-16  Bernd Schmidt  <bernds@codesourcery.com>
 
 	PR rtl-optimization/52773
@@ -834,7 +839,7 @@
 	* g++.dg/tsan/atomic_free.C: Likewise.
 	* g++.dg/tsan/atomic_free2.C: Likewise.
 	* g++.dg/tsan/cond_race.C: Likewise.
-	* g++.dg/tsan/tsan_barrier.h: Copied from c-c++-common/tsan. 
+	* g++.dg/tsan/tsan_barrier.h: Copied from c-c++-common/tsan.
 
 2015-01-08  Hans-Peter Nilsson  <hp@axis.com>
 
diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90
index eb00778..a2fabe8 100644
--- a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90
@@ -2,15 +2,23 @@
 !
 ! PR fortran/51055
 ! PR fortran/49110
-!
+! PR fortran/60334
 
 subroutine test()
   implicit none
   integer :: i = 5
   character(len=:), allocatable :: s1
+  character(len=:), pointer :: s2
+  character(len=5), target :: fifeC = 'FIVEC'
   call sub(s1, i)
   if (len(s1) /= 5) call abort()
   if (s1 /= "ZZZZZ") call abort()
+  s2 => subfunc()
+  if (len(s2) /= 5) call abort()
+  if (s2 /= "FIVEC") call abort()
+  s1 = addPrefix(subfunc())
+  if (len(s1) /= 7) call abort()
+  if (s1 /= "..FIVEC") call abort()
 contains
   subroutine sub(str,j)
     character(len=:), allocatable :: str
@@ -19,6 +27,17 @@ contains
     if (len(str) /= 5) call abort()
     if (str /= "ZZZZZ") call abort()
   end subroutine sub
+  function subfunc() result(res)
+    character(len=:), pointer :: res
+    res => fifec
+    if (len(res) /= 5) call abort()
+    if (res /= "FIVEC") call abort()
+  end function subfunc
+  function addPrefix(str) result(res)
+    character(len=:), pointer :: str
+    character(len=:), allocatable :: res
+    res = ".." // str
+  end function addPrefix
 end subroutine test
 
 program a