[patch,fortran] PR 16136: ALLOCATABLE dummy arguments

[Erik Edelmann]

On Mon, Mar 06, 2006 at 11:47:20PM +0200, Erik Edelmann wrote:
> Ok, attached is a patch that implements Paul's suggestion, and
> his revised version of allocatable_dummy_1.f90.  Regression
> tested on trunk, on Linux/x86.  Ok to commit?

Damn.  Forgot the patch.


        Erik
-------------- next part --------------
Index: gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90	(revision 111788)
+++ gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90	(working copy)
@@ -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
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 111788)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -1890,6 +1890,16 @@ gfc_conv_function_call (gfc_se * se, gfc
 		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);
+                }
+
 	    } 
 	}
 
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 111788)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -4297,6 +4297,34 @@ gfc_conv_array_parameter (gfc_se * se, g
 }
 
 
+/* 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 * s
   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 * s
   /* 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);
     }
 
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h	(revision 111788)
+++ gcc/fortran/trans-array.h	(working copy)
@@ -42,6 +42,8 @@ tree gfc_trans_auto_array_allocation (tr
 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.  */