trans-array.c (gfc_trans_dealloc_allocated): New function.

fortran/
2005-03-06  Paul Thomas  <pault@gcc.gnu.org>
            Erik Edelmann  <eedelman@gcc.gnu.org>

        * trans-array.c (gfc_trans_dealloc_allocated): New function.
        (gfc_trans_deferred_array): Use it, instead of inline code.
        * trans-array.h: Prototype for gfc_trans_dealloc_allocated().
        * trans-expr.c (gfc_conv_function_call): Deallocate allocated
        ALLOCATABLE, INTENT(OUT) arguments upon procedure entry.


testsuite/
2005-03-06  Paul Thomas  <pault@gcc.gnu.org>
            Erik Edelmann  <eedelman@gcc.gnu.org>

        * gfortran.dg/allocatable_dummy_1.f90: Take into account that
        INTENT(OUT) arguments shall be deallocated upon procedure entry.


Co-Authored-By: Erik Edelmann <eedelman@gcc.gnu.org>

From-SVN: r111795

4 files changed, 50 insertions, 14 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dcc3c59..a254807 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2005-03-06  Paul Thomas  <pault@gcc.gnu.org>
+            Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_dealloc_allocated): New function.
+	(gfc_trans_deferred_array): Use it, instead of inline code.
+	* trans-array.h: Prototype for gfc_trans_dealloc_allocated().
+	* trans-expr.c (gfc_conv_function_call): Deallocate allocated
+	ALLOCATABLE, INTENT(OUT) arguments upon procedure entry.
+
 2006-03-06  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/26107
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 20647b1..9f5337b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4297,6 +4297,34 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
 }
 
 
+/* Generate code to deallocate the symbol 'sym', if it is allocated.  */
+
+tree
+gfc_trans_dealloc_allocated (gfc_symbol * sym)
+{ 
+  tree tmp;
+  tree descriptor;
+  tree deallocate;
+  stmtblock_t block;
+
+  gcc_assert (sym->attr.allocatable);
+
+  gfc_start_block (&block);
+  descriptor = sym->backend_decl;
+  deallocate = gfc_array_deallocate (descriptor, null_pointer_node);
+
+  tmp = gfc_conv_descriptor_data_get (descriptor);
+  tmp = build2 (NE_EXPR, boolean_type_node, tmp,
+                build_int_cst (TREE_TYPE (tmp), 0));
+  tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ());
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = gfc_finish_block (&block);
+
+  return tmp;
+}
+
+
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.  */
 
 tree
@@ -4305,8 +4333,6 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
   tree type;
   tree tmp;
   tree descriptor;
-  tree deallocate;
-  stmtblock_t block;
   stmtblock_t fnblock;
   locus loc;
 
@@ -4359,18 +4385,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
   /* Allocatable arrays need to be freed when they go out of scope.  */
   if (sym->attr.allocatable)
     {
-      gfc_start_block (&block);
-
-      /* Deallocate if still allocated at the end of the procedure.  */
-      deallocate = gfc_array_deallocate (descriptor, null_pointer_node);
-
-      tmp = gfc_conv_descriptor_data_get (descriptor);
-      tmp = build2 (NE_EXPR, boolean_type_node, tmp, 
-		    build_int_cst (TREE_TYPE (tmp), 0));
-      tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ());
-      gfc_add_expr_to_block (&block, tmp);
-
-      tmp = gfc_finish_block (&block);
+      tmp = gfc_trans_dealloc_allocated (sym);
       gfc_add_expr_to_block (&fnblock, tmp);
     }
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 8038f40..fed1bf0 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -42,6 +42,8 @@ tree gfc_trans_auto_array_allocation (tree, gfc_symbol *, tree);
 tree gfc_trans_dummy_array_bias (gfc_symbol *, tree, tree);
 /* Generate entry and exit code for g77 calling convention arrays.  */
 tree gfc_trans_g77_array (gfc_symbol *, tree);
+/* Generate code to deallocate the symbol 'sym', if it is allocated.  */
+tree gfc_trans_dealloc_allocated (gfc_symbol * sym);
 /* Add initialization for deferred arrays.  */
 tree gfc_trans_deferred_array (gfc_symbol *, tree);
 /* Generate an initializer for a static pointer or allocatable array.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 4be5459..8c63b11 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1914,6 +1914,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 		gfc_conv_aliased_arg (&parmse, arg->expr, f);
 	      else
 	        gfc_conv_array_parameter (&parmse, arg->expr, argss, f);
+
+              /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is 
+                 allocated on entry, it must be deallocated.  */
+              if (formal && formal->sym->attr.allocatable
+                  && formal->sym->attr.intent == INTENT_OUT)
+                {
+                  tmp = gfc_trans_dealloc_allocated (arg->expr->symtree->n.sym);
+                  gfc_add_expr_to_block (&se->pre, tmp);
+                }
+
 	    } 
 	}