From patchwork Thu Feb 14 10:08:43 2013
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Fortran,committed] PR56138 - fix deferred-length character result
Date: Thu, 14 Feb 2013 00:08:43 -0000
From: Tobias Burnus <burnus@net-b.de>
X-Patchwork-Id: 220407
Message-Id: <511CB7AB.4020002@net-b.de>
To: gcc patches <gcc-patches@gcc.gnu.org>, gfortran <fortran@gcc.gnu.org>

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)
 		{