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

6 files changed, 70 insertions, 18 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);
+                }
+
 	    } 
 	}
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b1d03cf..ea84f84 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.
+
 2006-03-06  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/26107
diff --git a/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90
index f0581ad..db65d71 100644
--- a/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90
@@ -4,29 +4,39 @@ program alloc_dummy
 
     implicit none
     integer, allocatable :: a(:)
+    integer, allocatable :: b(:)
 
     call init(a)
     if (.NOT.allocated(a)) call abort()
     if (.NOT.all(a == [ 1, 2, 3 ])) call abort()
 
+    call useit(a, b)
+    if (.NOT.all(b == [ 1, 2, 3 ])) call abort()
+
     call kill(a)
     if (allocated(a)) call abort()
 
+    call kill(b)
+    if (allocated(b)) call abort()
 
 contains
 
     subroutine init(x)
         integer, allocatable, intent(out) :: x(:)
-
         allocate(x(3))
         x = [ 1, 2, 3 ]
     end subroutine init
 
-    
+    subroutine useit(x, y)
+        integer, allocatable, intent(in)  :: x(:)
+        integer, allocatable, intent(out) :: y(:)
+        if (allocated(y)) call abort()
+        allocate (y(3))
+        y = x
+    end subroutine useit
+
     subroutine kill(x)
         integer, allocatable, intent(out) :: x(:)
-
-        deallocate(x)
     end subroutine kill
 
 end program alloc_dummy