diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2006-03-06 23:12:41 +0000 |
|---|---|---|
| committer | Erik Edelmann <eedelman@gcc.gnu.org> | 2006-03-06 23:12:41 +0000 |
| commit | 42a0e16c2dcda2e87a3291ca4aa9cf944fee8f5a (patch) | |
| tree | 14bd2a8f3c2db1490455660b4df051b8316fdbb4 /gcc/fortran/trans-array.c | |
| parent | c09a1bf1a26983051a572cf9d7e8bd9164e4588b (diff) | |
| download | gcc-42a0e16c2dcda2e87a3291ca4aa9cf944fee8f5a.zip gcc-42a0e16c2dcda2e87a3291ca4aa9cf944fee8f5a.tar.gz gcc-42a0e16c2dcda2e87a3291ca4aa9cf944fee8f5a.tar.bz2 | |
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
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 43 |
1 files changed, 29 insertions, 14 deletions
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); } |