2009-10-09 Janus Weil <janus@gcc.gnu.org>

	PR fortran/41579
	* gfortran.h (gfc_select_type_stack): New struct, to be used as a stack
	for SELECT TYPE statements.
	(select_type_stack): New global variable.
	(type_selector,select_type_tmp): Removed.
	* match.c (type_selector,type_selector): Removed.
	(select_type_stack): New variable, serving as a stack for
	SELECT TYPE statements.
	(select_type_push,select_type_set_tmp): New functions.
	(gfc_match_select_type): Call select_type_push.
	(gfc_match_type_is): Call select_type_set_tmp.
	* parse.c (select_type_pop): New function.
	(parse_select_type_block): Call select_type_pop.
	* symbol.c (select_type_insert_tmp): New function.
	(gfc_find_sym_tree): Call select_type_insert_tmp.


2009-10-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41579
	* gfortran.dg/select_type_6.f03: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152600 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 36 insertions, 10 deletions

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d2c3ef021f4..3542944a50b 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -29,9 +29,8 @@ along with GCC; see the file COPYING3.  If not see
 int gfc_matching_procptr_assignment = 0;
 bool gfc_matching_prefix = false;
 
-/* Used for SELECT TYPE statements.  */
-gfc_symbol *type_selector;
-gfc_symtree *select_type_tmp;
+/* Stack of SELECT TYPE statements.  */
+gfc_select_type_stack *select_type_stack = NULL;
 
 /* For debugging and diagnostic purposes.  Return the textual representation
    of the intrinsic operator OP.  */
@@ -4021,6 +4020,38 @@ gfc_match_select (void)
 }
 
 
+/* Push the current selector onto the SELECT TYPE stack.  */
+
+static void
+select_type_push (gfc_symbol *sel)
+{
+  gfc_select_type_stack *top = gfc_get_select_type_stack ();
+  top->selector = sel;
+  top->tmp = NULL;
+  top->prev = select_type_stack;
+
+  select_type_stack = top;
+}
+
+
+/* Set the temporary for the current SELECT TYPE selector.  */
+
+static void
+select_type_set_tmp (gfc_typespec *ts)
+{
+  char name[GFC_MAX_SYMBOL_LEN];
+  gfc_symtree *tmp;
+
+  sprintf (name, "tmp$%s", ts->u.derived->name);
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
+  tmp->n.sym->ts = *ts;
+  tmp->n.sym->attr.referenced = 1;
+  tmp->n.sym->attr.pointer = 1;
+
+  select_type_stack->tmp = tmp;
+}
+
+
 /* Match a SELECT TYPE statement.  */
 
 match
@@ -4082,7 +4113,7 @@ gfc_match_select_type (void)
   new_st.expr2 = expr2;
   new_st.ext.ns = gfc_current_ns;
 
-  type_selector = expr1->symtree->n.sym;
+  select_type_push (expr1->symtree->n.sym);
 
   return MATCH_YES;
 }
@@ -4167,7 +4198,6 @@ gfc_match_type_is (void)
 {
   gfc_case *c = NULL;
   match m;
-  char name[GFC_MAX_SYMBOL_LEN];
 
   if (gfc_current_state () != COMP_SELECT_TYPE)
     {
@@ -4199,11 +4229,7 @@ gfc_match_type_is (void)
   new_st.ext.case_list = c;
 
   /* Create temporary variable.  */
-  sprintf (name, "tmp$%s", c->ts.u.derived->name);
-  gfc_get_sym_tree (name, gfc_current_ns, &select_type_tmp, false);
-  select_type_tmp->n.sym->ts = c->ts;
-  select_type_tmp->n.sym->attr.referenced = 1;
-  select_type_tmp->n.sym->attr.pointer = 1;
+  select_type_set_tmp (&c->ts);
 
   return MATCH_YES;