Re: [Fortran, (RFC) patch] PR49110/51055 Assignment to alloc. deferred-length character vars

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

Jakub Jelinek wrote:
> > As written, TREE_STATIC is currently not set (which is a bug, cf.
> > PR55733);

That's now fixed. I also add to remove a spurious free() call.

> If that is changed, surely the name must be mangled too.
> Perhaps best to set a bool variable to the condition and use it in both
> places.
>    bool static_length = sym->attr.save
> 		      || sym->ns->proc_name->attr.flavor == FL_MODULE
> 		      || gfc_option.flag_max_stack_var_size == 0;
>    if (static_length)

I did so now.


Updated patch attached. Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
2012-12-11  Tobias Burnus  <burnus@net-b.de>
	    Jakub Jelinek  <jakub@redhat.com>
	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/55636
	PR fortran/55733
	* gfortran.h (GFC_PREFIX): Define.
	* trans-decl.c (gfc_create_string_length): For VAR_DECLs that
	will be TREE_STATIC, use GFC_PREFIX to mangle the names. Handle
	-fno-automatic
	(gfc_trans_deferred_vars): Don't free variables SAVEd via
	-fno-automatic.

2012-12-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/55733
	* gfortran.dg/save_5.f90: New.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bf767b2..74162e7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -63,6 +63,15 @@ along with GCC; see the file COPYING3.  If not see
 #define PREFIX(x) "_gfortran_" x
 #define PREFIX_LEN 10
 
+/* A prefix for internal variables, which are not user-visible.  */
+#if !defined (NO_DOT_IN_LABEL)
+# define GFC_PREFIX(x) "_F." x
+#elif !defined (NO_DOLLAR_IN_LABEL)
+# define GFC_PREFIX(x) "_F$" x
+#else
+# define GFC_PREFIX(x) "_F_" x
+#endif
+
 #define BLANK_COMMON_NAME "__BLNK__"
 
 /* Macro to initialize an mstring structure.  */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index dbc5a10..3202840 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1089,8 +1089,22 @@ gfc_create_string_length (gfc_symbol * sym)
       tree length;
       const char *name;
 
-      /* Also prefix the mangled name.  */
-      if (sym->module)
+      bool static_length = sym->attr.save
+			   || sym->ns->proc_name->attr.flavor == FL_MODULE
+			   || gfc_option.flag_max_stack_var_size == 0;
+
+      /* Also prefix the mangled name. We need to call GFC_PREFIX for static
+	 variables as some systems do not support the "." in the assembler name.
+	 For nonstatic variables, the "." does not appear in assembler.  */
+      if (static_length)
+	{
+	  if (sym->module)
+	    name = gfc_get_string (GFC_PREFIX ("%s_MOD_%s"), sym->module,
+				   sym->name);
+	  else
+	    name = gfc_get_string (GFC_PREFIX ("%s"), sym->name);
+	}
+      else if (sym->module)
 	name = gfc_get_string (".__%s_MOD_%s", sym->module, sym->name);
       else
 	name = gfc_get_string (".%s", sym->name);
@@ -1105,7 +1119,7 @@ gfc_create_string_length (gfc_symbol * sym)
 
       sym->ts.u.cl->backend_decl = length;
 
-      if (sym->attr.save || sym->ns->proc_name->attr.flavor == FL_MODULE)
+      if (static_length)
 	TREE_STATIC (length) = 1;
 
       if (sym->ns->proc_name->attr.flavor == FL_MODULE
@@ -3702,7 +3716,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		    || (sym->ts.type == BT_CLASS
 			&& CLASS_DATA (sym)->attr.allocatable)))
 	{
-	  if (!sym->attr.save)
+	  if (!sym->attr.save && gfc_option.flag_max_stack_var_size != 0)
 	    {
 	      tree descriptor = NULL_TREE;
 
diff --git a/gcc/testsuite/gfortran.dg/save_5.f90 b/gcc/testsuite/gfortran.dg/save_5.f90
new file mode 100644
index 0000000..20d3b7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_5.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options "-fno-automatic" }
+!
+! PR fortran/55733
+!
+! Check that -fno-automatic makes the local variable SAVEd
+!
+
+! Scalar allocatable
+subroutine foo(i)
+  integer :: i
+  integer, allocatable :: j
+  if (i == 1) j = 42
+  if (.not. allocated (j)) call abort ()
+  if (j /= 42) call abort ()
+end
+
+! Deferred-length string scalar
+subroutine bar()
+  logical, save :: first = .true.
+  character(len=:), allocatable :: str
+  if (first) then
+    first = .false.
+    if (allocated (str)) call abort ()
+    str = "ABCDEF"
+  end if
+  if (.not. allocated (str)) call abort ()
+  if (len (str) /= 6) call abort ()
+  if (str(1:6) /= "ABCDEF") call abort ()
+end subroutine bar
+
+! Deferred-length string array
+subroutine bar_array()
+  logical, save :: first = .true.
+  character(len=:), allocatable :: str
+  if (first) then
+    first = .false.
+    if (allocated (str)) call abort ()
+    str = "ABCDEF"
+  end if
+  if (.not. allocated (str)) call abort ()
+  if (len (str) /= 6) call abort ()
+  if (str(1:6) /= "ABCDEF") call abort ()
+end subroutine bar_array
+
+call foo(1)
+call foo(2)
+call bar()
+call bar_array()
+call bar()
+call bar_array()
+end