re PR fortran/44709 (BLOCK and GOTO/EXIT/CYCLE)

2010-07-15  Daniel Kraft  <d@domob.eu>

	PR fortran/44709
	* trans.h (struct gfc_wrapped_block): New struct.
	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
	(gfc_finish_wrapped_block): New method.
	(gfc_init_default_dt): Add new init code to block rather than
	returning it.
	* trans-array.h (gfc_trans_auto_array_allocation): Use gfc_wrapped_block
	(gfc_trans_dummy_array_bias): Ditto.
	(gfc_trans_g77_array): Ditto.
	(gfc_trans_deferred_array): Ditto.
	* trans.c (gfc_add_expr_to_block): Call add_expr_to_chain.
	(add_expr_to_chain): New method based on old gfc_add_expr_to_block.
	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
	(gfc_finish_wrapped_block): New method.
	* trans-array.c (gfc_trans_auto_array_allocation): use gfc_wrapped_block
	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
	(gfc_trans_deferred_array): Ditto.
	* trans-decl.c (gfc_trans_dummy_character): Ditto.
	(gfc_trans_auto_character_variable), (gfc_trans_assign_aux_var): Ditto.
	(init_intent_out_dt): Ditto.
	(gfc_init_default_dt): Add new init code to block rather than
	returning it.
	(gfc_trans_deferred_vars): Use gfc_wrapped_block to collect all init
	and cleanup code and put it all together.

From-SVN: r162219

gcc/fortran/ChangeLog

+2010-07-15  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/44709
+	* trans.h (struct gfc_wrapped_block): New struct.
+	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
+	(gfc_finish_wrapped_block): New method.
+	(gfc_init_default_dt): Add new init code to block rather than
+	returning it.
+	* trans-array.h (gfc_trans_auto_array_allocation): Use gfc_wrapped_block
+	(gfc_trans_dummy_array_bias): Ditto.
+	(gfc_trans_g77_array): Ditto.
+	(gfc_trans_deferred_array): Ditto.
+	* trans.c (gfc_add_expr_to_block): Call add_expr_to_chain.
+	(add_expr_to_chain): New method based on old gfc_add_expr_to_block.
+	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
+	(gfc_finish_wrapped_block): New method.
+	* trans-array.c (gfc_trans_auto_array_allocation): use gfc_wrapped_block
+	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
+	(gfc_trans_deferred_array): Ditto.
+	* trans-decl.c (gfc_trans_dummy_character): Ditto.
+	(gfc_trans_auto_character_variable), (gfc_trans_assign_aux_var): Ditto.
+	(init_intent_out_dt): Ditto.
+	(gfc_init_default_dt): Add new init code to block rather than
+	returning it.
+	(gfc_trans_deferred_vars): Use gfc_wrapped_block to collect all init
+	and cleanup code and put it all together.
+
 2010-07-15  Jakub Jelinek  <jakub@redhat.com>
 
 	* trans.h (gfc_build_compare_string): Add CODE argument.

gcc/fortran/trans-array.h

@@ -37,11 +37,11 @@ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
 
 /* Generate function entry code for allocation of compiler allocated array
    variables.  */
-tree gfc_trans_auto_array_allocation (tree, gfc_symbol *, tree);
+void gfc_trans_auto_array_allocation (tree, gfc_symbol *, gfc_wrapped_block *);
 /* Generate entry and exit code for dummy array parameters.  */
-tree gfc_trans_dummy_array_bias (gfc_symbol *, tree, tree);
+void gfc_trans_dummy_array_bias (gfc_symbol *, tree, gfc_wrapped_block *);
 /* Generate entry and exit code for g77 calling convention arrays.  */
-tree gfc_trans_g77_array (gfc_symbol *, tree);
+void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *);
 /* Generate code to deallocate an array, if it is allocated.  */
 tree gfc_trans_dealloc_allocated (tree);
 
@@ -58,7 +58,7 @@ tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
 tree gfc_copy_only_alloc_comp (gfc_symbol *, tree, tree, int);
 
 /* Add initialization for deferred arrays.  */
-tree gfc_trans_deferred_array (gfc_symbol *, tree);
+void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *);
 /* Generate an initializer for a static pointer or allocatable array.  */
 void gfc_trans_static_array_pointer (gfc_symbol *);
 

gcc/fortran/trans.c

@@ -977,31 +977,47 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
   return res;
 }
 
-/* Add a statement to a block.  */
 
-void
-gfc_add_expr_to_block (stmtblock_t * block, tree expr)
-{
-  gcc_assert (block);
+/* Add an expression to another one, either at the front or the back.  */
 
+static void
+add_expr_to_chain (tree* chain, tree expr, bool front)
+{
   if (expr == NULL_TREE || IS_EMPTY_STMT (expr))
     return;
 
-  if (block->head)
+  if (*chain)
     {
-      if (TREE_CODE (block->head) != STATEMENT_LIST)
+      if (TREE_CODE (*chain) != STATEMENT_LIST)
 	{
 	  tree tmp;
 
-	  tmp = block->head;
-	  block->head = NULL_TREE;
-	  append_to_statement_list (tmp, &block->head);
+	  tmp = *chain;
+	  *chain = NULL_TREE;
+	  append_to_statement_list (tmp, chain);
 	}
-      append_to_statement_list (expr, &block->head);
+
+      if (front)
+	{
+	  tree_stmt_iterator i;
+
+	  i = tsi_start (*chain);
+	  tsi_link_before (&i, expr, TSI_CONTINUE_LINKING);
+	}
+      else
+	append_to_statement_list (expr, chain);
     }
   else
-    /* Don't bother creating a list if we only have a single statement.  */
-    block->head = expr;
+    *chain = expr;
+}
+
+/* Add a statement to a block.  */
+
+void
+gfc_add_expr_to_block (stmtblock_t * block, tree expr)
+{
+  gcc_assert (block);
+  add_expr_to_chain (&block->head, expr, false);
 }
 
 
@@ -1393,3 +1409,55 @@ gfc_generate_module_code (gfc_namespace * ns)
     }
 }
 
+
+/* Initialize an init/cleanup block with existing code.  */
+
+void
+gfc_start_wrapped_block (gfc_wrapped_block* block, tree code)
+{
+  gcc_assert (block);
+
+  block->init = NULL_TREE;
+  block->code = code;
+  block->cleanup = NULL_TREE;
+}
+
+
+/* Add a new pair of initializers/clean-up code.  */
+
+void
+gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup)
+{
+  gcc_assert (block);
+
+  /* The new pair of init/cleanup should be "wrapped around" the existing
+     block of code, thus the initialization is added to the front and the
+     cleanup to the back.  */
+  add_expr_to_chain (&block->init, init, true);
+  add_expr_to_chain (&block->cleanup, cleanup, false);
+}
+
+
+/* Finish up a wrapped block by building a corresponding try-finally expr.  */
+
+tree
+gfc_finish_wrapped_block (gfc_wrapped_block* block)
+{
+  tree result;
+
+  gcc_assert (block);
+
+  /* Build the final expression.  For this, just add init and body together,
+     and put clean-up with that into a TRY_FINALLY_EXPR.  */
+  result = block->init;
+  add_expr_to_chain (&result, block->code, false);
+  if (block->cleanup)
+    result = build2 (TRY_FINALLY_EXPR, void_type_node, result, block->cleanup);
+  
+  /* Clear the block.  */
+  block->init = NULL_TREE;
+  block->code = NULL_TREE;
+  block->cleanup = NULL_TREE;
+
+  return result;
+}

gcc/fortran/trans.h

@@ -258,6 +258,29 @@ typedef struct
 gfc_saved_var;
 
 
+/* Store information about a block of code together with special
+   initialization and clean-up code.  This can be used to incrementally add
+   init and cleanup, and in the end put everything together to a
+   try-finally expression.  */
+typedef struct
+{
+  tree init;
+  tree cleanup;
+  tree code;
+}
+gfc_wrapped_block;
+
+
+/* Initialize an init/cleanup block.  */
+void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code);
+/* Add a pair of init/cleanup code to the block.  Each one might be a
+   NULL_TREE if not required.  */
+void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup);
+/* Finalize the block, that is, create a single expression encapsulating the
+   original code together with init and clean-up code.  */
+tree gfc_finish_wrapped_block (gfc_wrapped_block* block);
+
+
 /* Advance the SS chain to the next term.  */
 void gfc_advance_se_ss_chain (gfc_se *);
 
@@ -403,7 +426,7 @@ tree gfc_get_symbol_decl (gfc_symbol *);
 tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool);
 
 /* Assign a default initializer to a derived type.  */
-tree gfc_init_default_dt (gfc_symbol *, tree, bool);
+void gfc_init_default_dt (gfc_symbol *, stmtblock_t *, bool);
 
 /* Substitute a temporary variable in place of the real one.  */
 void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);