[Patch, Fortran, committed] PR56138 - fix deferred-length character result

[Tobias Burnus <burnus at net-b dot de>]

This patch undoes the patch 
http://gcc.gnu.org/ml/fortran/2013-01/msg00219.html which doesn't fix 
the original problem. (The ICE only occurs if the function is not an 
internal or module procedure!)

As Paul's variant (cf. PR) fixes the issue, this patch now undoes my 
patch and uses his. Additionally, it adds a modified test case (by 
Dominique) which uses a bare, non-contained function.

Build and regtested on x86-64-gnu-linux.

Tobias
Index: gcc/testsuite/gfortran.dg/allocatable_function_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocatable_function_7.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/allocatable_function_7.f90	(Revision 196047)
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR fortran/56138
+!
+! Contributed by Dominique d'Humieres and John Chludzinski,
+! using the code of John Reid
+!
+implicit none
+interface
+PURE FUNCTION s_to_c(string)
+  CHARACTER(LEN=*),INTENT(IN)   :: string
+  CHARACTER(LEN=:),ALLOCATABLE :: s_to_c
+ENDFUNCTION s_to_c
+end interface
+CHARACTER(LEN=:),ALLOCATABLE :: str 
+if (s_to_c("ABCdef") /= "ABCdef" .or. len(s_to_c("ABCdef")) /= 6) call abort()
+str = s_to_c("ABCdef")
+if (str /= "ABCdef" .or. len(str) /= 6) call abort()
+str(1:3) = s_to_c("123")
+if (str /= "123def" .or. len(str) /= 6) call abort()
+
+end
+
+PURE FUNCTION s_to_c(string) 
+  CHARACTER(LEN=*),INTENT(IN)   :: string 
+  CHARACTER(LEN=:),ALLOCATABLE :: s_to_c 
+  s_to_c = string
+END FUNCTION s_to_c 
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 196046)
+++ gcc/testsuite/ChangeLog	(Revision 196047)
@@ -1,3 +1,9 @@
+2013-02-14  Dominique d'Humieres  <dominiq@lps.ens.fr>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR testsuite/56138
+	* gfortran.dg/allocatable_function_7.f90: New.
+
 2013-02-14  Jakub Jelinek  <jakub@redhat.com>
 
 	* g++.dg/asan/dejagnu-gtest.h: Add multiple inclusion guards.
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 196046)
+++ gcc/fortran/ChangeLog	(Revision 196047)
@@ -1,3 +1,17 @@
+2013-02-14  Paul Thomas  <pault@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR testsuite/56138
+	* trans-decl.c (gfc_get_symbol_decl): Fix deferred-length
+	results for functions without extra result variable.
+
+	Revert:
+	2013-01-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56138
+	* trans-decl.c (gfc_trans_deferred_vars): Fix deferred-length
+	results for functions without extra result variable.
+
 2013-02-12  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/46952
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 196046)
+++ gcc/fortran/trans-decl.c	(Revision 196047)
@@ -1205,6 +1205,7 @@
   tree attributes;
   int byref;
   bool intrinsic_array_parameter = false;
+  bool fun_or_res;
 
   gcc_assert (sym->attr.referenced
 	      || sym->attr.flavor == FL_PROCEDURE
@@ -1244,7 +1245,9 @@
       length = gfc_create_string_length (sym);
     }
 
-  if ((sym->attr.dummy && ! sym->attr.function) || (sym->attr.result && byref))
+  fun_or_res = byref && (sym->attr.result
+			 || (sym->attr.function && sym->ts.deferred));
+  if ((sym->attr.dummy && ! sym->attr.function) || fun_or_res)
     {
       /* Return via extra parameter.  */
       if (sym->attr.result && byref
@@ -1270,7 +1273,7 @@
 	     (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl))
 	    sym->ts.u.cl->backend_decl = NULL_TREE;
 
-	  if (sym->ts.deferred && sym->attr.result
+	  if (sym->ts.deferred && fun_or_res
 		&& sym->ts.u.cl->passed_length == NULL
 		&& sym->ts.u.cl->backend_decl)
 	    {
@@ -3775,7 +3778,7 @@
 					        null_pointer_node));
 		}
 
-	      if ((sym->attr.dummy || sym->attr.result || sym->result == sym)
+	      if ((sym->attr.dummy ||sym->attr.result)
 		    && sym->ts.type == BT_CHARACTER
 		    && sym->ts.deferred)
 		{