diff mbox

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

Message ID 511CB7AB.4020002@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Feb. 14, 2013, 10:08 a.m. UTC 
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
diff mbox

Patch

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