re PR fortran/39626 (Correctly implement details of Fortran 2008 BLOCK construct)

2009-09-29  Daniel Kraft  <d@domob.eu>

	PR fortran/39626
	* gfortran.h (enum gfc_statement): Add ST_BLOCK and ST_END_BLOCK.
	(struct gfc_namespace): Convert flags to bit-fields and add flag
	`construct_entities' for use with BLOCK constructs.
	(enum gfc_exec_code): Add EXEC_BLOCK.
	(struct gfc_code): Add namespace field to union for EXEC_BLOCK.
	* match.h (gfc_match_block): New prototype.
	* parse.h (enum gfc_compile_state): Add COMP_BLOCK.
	* trans.h (gfc_process_block_locals): New prototype.
	(gfc_trans_deferred_vars): Made public, new prototype.
	* trans-stmt.h (gfc_trans_block_construct): New prototype.
	* decl.c (gfc_match_end): Handle END BLOCK correctly.
	(gfc_match_intent): Error if inside of BLOCK.
	(gfc_match_optional), (gfc_match_value): Ditto.
	* match.c (gfc_match_block): New routine.
	* parse.c (decode_statement): Handle BLOCK statement.
	(case_exec_markers): Add ST_BLOCK.
	(case_end): Add ST_END_BLOCK.
	(gfc_ascii_statement): Handle ST_BLOCK and ST_END_BLOCK.
	(parse_spec): Check for statements not allowed inside of BLOCK.
	(parse_block_construct): New routine.
	(parse_executable): Parse BLOCKs.
	(parse_progunit): Disallow CONTAINS in BLOCK constructs.
	* resolve.c (is_illegal_recursion): Find real container procedure and
	don't get confused by BLOCK constructs.
	(resolve_block_construct): New routine.
	(gfc_resolve_blocks), (resolve_code): Handle EXEC_BLOCK.
	* st.c (gfc_free_statement): Handle EXEC_BLOCK statements.
	* trans-decl.c (saved_local_decls): New static variable.
	(add_decl_as_local): New routine.
	(gfc_finish_var_decl): Add variable as local if inside BLOCK.
	(gfc_trans_deferred_vars): Make public.
	(gfc_process_block_locals): New routine.
	* trans-stmt.c (gfc_trans_block_construct): New routine.
	* trans.c (gfc_trans_code): Handle EXEC_BLOCK statements.

2009-09-29  Daniel Kraft  <d@domob.eu>

	PR fortran/39626
	* gfortran.dg/block_1.f08: New test.
	* gfortran.dg/block_2.f08: New test.
	* gfortran.dg/block_3.f90: New test.
	* gfortran.dg/block_4.f08: New test.
	* gfortran.dg/block_5.f08: New test.
	* gfortran.dg/block_6.f08: New test.
	* gfortran.dg/block_7.f08: New test.
	* gfortran.dg/block_8.f08: New test.

From-SVN: r152266

1 files changed, 43 insertions, 2 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4e72a23..3d6a5e2 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -64,6 +64,10 @@ static GTY(()) tree saved_parent_function_decls;
 static struct pointer_set_t *nonlocal_dummy_decl_pset;
 static GTY(()) tree nonlocal_dummy_decls;
 
+/* Holds the variable DECLs that are locals.  */
+
+static GTY(()) tree saved_local_decls;
+
 /* The namespace of the module we're currently generating.  Only used while
    outputting decls for module variables.  Do not rely on this being set.  */
 
@@ -180,6 +184,16 @@ gfc_add_decl_to_function (tree decl)
   saved_function_decls = decl;
 }
 
+static void
+add_decl_as_local (tree decl)
+{
+  gcc_assert (decl);
+  TREE_USED (decl) = 1;
+  DECL_CONTEXT (decl) = current_function_decl;
+  TREE_CHAIN (decl) = saved_local_decls;
+  saved_local_decls = decl;
+}
+
 
 /* Build a  backend label declaration.  Set TREE_USED for named labels.
    The context of the label is always the current_function_decl.  All
@@ -504,8 +518,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
   if (current_function_decl != NULL_TREE)
     {
       if (sym->ns->proc_name->backend_decl == current_function_decl
-          || sym->result == sym)
+	  || sym->result == sym)
 	gfc_add_decl_to_function (decl);
+      else if (sym->ns->proc_name->attr.flavor == FL_LABEL)
+	/* This is a BLOCK construct.  */
+	add_decl_as_local (decl);
       else
 	gfc_add_decl_to_parent_function (decl);
     }
@@ -3036,7 +3053,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
     Initialization and possibly repacking of dummy arrays.
     Initialization of ASSIGN statement auxiliary variable.  */
 
-static tree
+tree
 gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 {
   locus loc;
@@ -4552,4 +4569,28 @@ gfc_generate_block_data (gfc_namespace * ns)
 }
 
 
+/* Process the local variables of a BLOCK construct.  */
+
+void
+gfc_process_block_locals (gfc_namespace* ns)
+{
+  tree decl;
+
+  gcc_assert (saved_local_decls == NULL_TREE);
+  generate_local_vars (ns);
+
+  decl = saved_local_decls;
+  while (decl)
+    {
+      tree next;
+
+      next = TREE_CHAIN (decl);
+      TREE_CHAIN (decl) = NULL_TREE;
+      pushdecl (decl);
+      decl = next;
+    }
+  saved_local_decls = NULL_TREE;
+}
+
+
 #include "gt-fortran-trans-decl.h"