re PR fortran/22290 (Optimize Assigned GOTO to cause error with -O1 or higher)

2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/22290
	* trans-decl.c (gfc_add_assign_aux_vars): New function. Add two
	auxiliary variables.
	(gfc_get_symbol_decl): Use it when a variable, including dummy
	argument, is assigned a label.
	(gfc_trans_assign_aux_var): New function. Set initial value of
	the auxiliary variable explicitly.
	(gfc_trans_deferred_vars): Use it.
	* trans-stmt.c (gfc_conv_label_variable): Handle dummy argument.

2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/22290
	* gfortran.dg/assign_5.f90: New test.
	* gfortran.dg/assign_6.f: New test.

From-SVN: r105887

6 files changed, 116 insertions, 17 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 87c993e..353e515 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/22290
+	* trans-decl.c (gfc_add_assign_aux_vars): New function. Add two
+	auxiliary variables.
+	(gfc_get_symbol_decl): Use it when a variable, including dummy
+	argument, is assigned a label.
+	(gfc_trans_assign_aux_var): New function. Set initial value of
+	the auxiliary variable explicitly.
+	(gfc_trans_deferred_vars): Use it.
+	* trans-stmt.c (gfc_conv_label_variable): Handle dummy argument.
+
 2005-10-24  Asher Langton  <langton2@llnl.gov>
 
 	PR fortran/17031
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4b6e226..15d9006 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -723,6 +723,39 @@ gfc_create_string_length (gfc_symbol * sym)
   return sym->ts.cl->backend_decl;
 }
 
+/* If a variable is assigned a label, we add another two auxiliary
+   variables.  */
+
+static void
+gfc_add_assign_aux_vars (gfc_symbol * sym)
+{
+  tree addr;
+  tree length;
+  tree decl;
+
+  gcc_assert (sym->backend_decl);
+
+  decl = sym->backend_decl;
+  gfc_allocate_lang_decl (decl);
+  GFC_DECL_ASSIGN (decl) = 1;
+  length = build_decl (VAR_DECL, create_tmp_var_name (sym->name),
+		       gfc_charlen_type_node);
+  addr = build_decl (VAR_DECL, create_tmp_var_name (sym->name),
+		     pvoid_type_node);
+  gfc_finish_var_decl (length, sym);
+  gfc_finish_var_decl (addr, sym);
+  /*  STRING_LENGTH is also used as flag. Less than -1 means that
+      ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the
+      target label's address. Otherwise, value is the length of a format string
+      and ASSIGN_ADDR is its address.  */
+  if (TREE_STATIC (length))
+    DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2);
+  else
+    gfc_defer_symbol_init (sym);
+
+  GFC_DECL_STRING_LEN (decl) = length;
+  GFC_DECL_ASSIGN_ADDR (decl) = addr;
+}
 
 /* Return the decl for a gfc_symbol, create it if it doesn't already
    exist.  */
@@ -780,6 +813,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	}
 
       TREE_USED (sym->backend_decl) = 1;
+      if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl) == 0)
+	{
+	  gfc_add_assign_aux_vars (sym);
+	}
       return sym->backend_decl;
     }
 
@@ -826,22 +863,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 
   gfc_finish_var_decl (decl, sym);
 
-  if (sym->attr.assign)
-    {
-      gfc_allocate_lang_decl (decl);
-      GFC_DECL_ASSIGN (decl) = 1;
-      length = gfc_create_var (gfc_charlen_type_node, sym->name);
-      GFC_DECL_STRING_LEN (decl) = length;
-      GFC_DECL_ASSIGN_ADDR (decl) = gfc_create_var (pvoid_type_node, sym->name);
-      /* TODO: Need to check we don't change TREE_STATIC (decl) later.  */
-      TREE_STATIC (length) = TREE_STATIC (decl);
-      /*  STRING_LENGTH is also used as flag. Less than -1 means that
-          ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the
-          target label's address. Other value is the length of format string
-          and ASSIGN_ADDR is the address of format string.  */
-      DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2);
-    }
-
   if (sym->ts.type == BT_CHARACTER)
     {
       /* Character variables need special handling.  */
@@ -866,6 +887,11 @@ gfc_get_symbol_decl (gfc_symbol * sym)
     }
   sym->backend_decl = decl;
 
+  if (sym->attr.assign)
+    {
+      gfc_add_assign_aux_vars (sym);
+    }
+
   if (TREE_STATIC (decl) && !sym->attr.use_assoc)
     {
       /* Add static initializer.  */
@@ -2105,12 +2131,32 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody)
   return gfc_finish_block (&body);
 }
 
+/* Set the initial value of ASSIGN statement auxiliary variable explicitly.  */
+
+static tree
+gfc_trans_assign_aux_var (gfc_symbol * sym, tree fnbody)
+{
+  stmtblock_t body;
+
+  gcc_assert (sym->backend_decl);
+  gfc_start_block (&body);
+
+  /* Set the initial value to length. See the comments in
+     function gfc_add_assign_aux_vars in this file.  */
+  gfc_add_modify_expr (&body, GFC_DECL_STRING_LEN (sym->backend_decl),
+		       build_int_cst (NULL_TREE, -2));
+
+  gfc_add_expr_to_block (&body, fnbody);
+  return gfc_finish_block (&body);
+}
+
 
 /* Generate function entry and exit code, and add it to the function body.
    This includes:
     Allocation and initialization of array variables.
     Allocation of character string variables.
-    Initialization and possibly repacking of dummy arrays.  */
+    Initialization and possibly repacking of dummy arrays.
+    Initialization of ASSIGN statement auxiliary variable.  */
 
 static tree
 gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
@@ -2211,6 +2257,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	    fnbody = gfc_trans_auto_character_variable (sym, fnbody);
 	  gfc_set_backend_locus (&loc);
 	}
+      else if (sym->attr.assign)
+	{
+	  gfc_get_backend_locus (&loc);
+	  gfc_set_backend_locus (&sym->declared_at);
+	  fnbody = gfc_trans_assign_aux_var (sym, fnbody);
+	  gfc_set_backend_locus (&loc);
+	}
       else
 	gcc_unreachable ();
     }
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 615d91d..f0fefdc 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -91,6 +91,9 @@ gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
   /* Deals with variable in common block. Get the field declaration.  */
   if (TREE_CODE (se->expr) == COMPONENT_REF)
     se->expr = TREE_OPERAND (se->expr, 1);
+  /* Deals with dummy argument. Get the parameter declaration.  */
+  else if (TREE_CODE (se->expr) == INDIRECT_REF)
+    se->expr = TREE_OPERAND (se->expr, 0);
 }
 
 /* Translate a label assignment statement.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 53cddc0..6039e88 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/22290
+	* gfortran.dg/assign_5.f90: New test.
+	* gfortran.dg/assign_6.f: New test.
+
 2005-10-25  Uros Bizjak  <uros@kss-loka.si>
 
 	* g++.dg/other/i386-1.C: Include i386-cpuid.h.  Pass if
diff --git a/gcc/testsuite/gfortran.dg/assign_5.f90 b/gcc/testsuite/gfortran.dg/assign_5.f90
new file mode 100644
index 0000000..632bd09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_5.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Assign a label to a dummy argument.
+! Option passed to avoid excess errors from obsolete warning
+! { dg-options "-w" }
+
+subroutine s1 (a)
+integer a
+assign 777 to a
+go to a
+777 continue
+end
+program test
+call s1 (1)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/assign_6.f b/gcc/testsuite/gfortran.dg/assign_6.f
new file mode 100644
index 0000000..135546b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_6.f
@@ -0,0 +1,10 @@
+C { dg-do run }
+C Option passed to avoid excess errors from obsolete warning
+C { dg-options "-w" }
+C PR22290
+
+      integer nz
+      assign 93 to nz
+      go to nz,(93)
+  93  continue
+      end