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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111795
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
}
+/* 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
tree type;
tree tmp;
tree descriptor;
- tree deallocate;
- stmtblock_t block;
stmtblock_t fnblock;
locus loc;
/* 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);
}
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. */
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);
+ }
+
}
}
+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
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