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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@219798 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c97de7f..eb02d88 100644 (file)
--- 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 (file)
--- 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 5ebf3ab..420d6ad 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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