procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/43178 (Pointless resetting to NULL for local ALLOCATABLEs)

Browse source 
2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43178
        * trans-array.c (gfc_conv_expr_descriptor): Update
        gfc_trans_scalar_assign call.
        (has_default_initializer): New function.
        (gfc_trans_deferred_array): Nullify less often.
        * trans-expr.c (gfc_conv_subref_array_arg,
        gfc_trans_subcomponent_assign): Update call to
        gfc_trans_scalar_assign.
        (gfc_trans_scalar_assign): Add parameter and pass it on.
        (gfc_trans_assignment_1): Optionally, do not dealloc before
        assignment.
        * trans-openmp.c (gfc_trans_omp_array_reduction): Update
        call to gfc_trans_scalar_assign.
        * trans-decl.c (gfc_get_symbol_decl): Do not always apply
        initializer to static variables.
        (gfc_init_default_dt): Add dealloc parameter and pass it on.
        * trans-stmt.c (forall_make_variable_temp,
        generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp,
        gfc_trans_forall_1, gfc_trans_where_assign, gfc_trans_where_3
        gfc_trans_allocate): Update gfc_trans_assignment call.
        * trans.h (gfc_trans_scalar_assign, gfc_init_default_dt,
        gfc_init_default_dt, gfc_trans_assignment): Add bool dealloc
        parameter to prototype.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43178
        * gfortran.dg/alloc_comp_basics_1.f90: Update
        * scan-tree-dump-times.
        * gfortran.dg/alloc_comp_constructor_1.f90: Ditto.
        * gfortran.dg/auto_dealloc_1.f90: Ditto.

From-SVN: r157993
This commit is contained in:
Tobias Burnus 2010-04-06 14:46:19 +02:00 • committed by Tobias Burnus
parent 56186ac266
commit 2b56d6a425
11 changed files with 124 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gcc/fortran/ChangeLog
View file

@ -1,3 +1,29 @@
2010-04-06 Tobias Burnus <burnus@net-b.de>
PR fortran/43178
* trans-array.c (gfc_conv_expr_descriptor): Update
gfc_trans_scalar_assign call.
(has_default_initializer): New function.
(gfc_trans_deferred_array): Nullify less often.
* trans-expr.c (gfc_conv_subref_array_arg,
gfc_trans_subcomponent_assign): Update call to
gfc_trans_scalar_assign.
(gfc_trans_scalar_assign): Add parameter and pass it on.
(gfc_trans_assignment_1): Optionally, do not dealloc before
assignment.
* trans-openmp.c (gfc_trans_omp_array_reduction): Update
call to gfc_trans_scalar_assign.
* trans-decl.c (gfc_get_symbol_decl): Do not always apply
initializer to static variables.
(gfc_init_default_dt): Add dealloc parameter and pass it on.
* trans-stmt.c (forall_make_variable_temp,
generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp,
gfc_trans_forall_1, gfc_trans_where_assign, gfc_trans_where_3
gfc_trans_allocate): Update gfc_trans_assignment call.
* trans.h (gfc_trans_scalar_assign, gfc_init_default_dt,
gfc_init_default_dt, gfc_trans_assignment): Add bool dealloc
parameter to prototype.
2010-03-31 Paul Thomas <pault@gcc.gnu.org>
* ioparm.def : Update copyright.

39
gcc/fortran/trans-array.c
View file

@ -5214,7 +5214,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
lse.string_length = rse.string_length;
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
expr->expr_type == EXPR_VARIABLE);
expr->expr_type == EXPR_VARIABLE, true);
gfc_add_expr_to_block (&block, tmp);
/* Finish the copying loops. */
@ -6176,6 +6176,25 @@ gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
}
/* Check for default initializer; sym->value is not enough as it is also
set for EXPR_NULL of allocatables. */
static bool
has_default_initializer (gfc_symbol *der)
{
gfc_component *c;
gcc_assert (der->attr.flavor == FL_DERIVED);
for (c = der->components; c; c = c->next)
if ((c->ts.type != BT_DERIVED && c->initializer)
|| (c->ts.type == BT_DERIVED
&& (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))
break;
return c != NULL;
}
/* NULLIFY an allocatable/pointer array on function entry, free it on exit.
Do likewise, recursively if necessary, with the allocatable components of
derived types. */
@ -6236,17 +6255,21 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
/* Get the descriptor type. */
type = TREE_TYPE (sym->backend_decl);
if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable))
{
if (!sym->attr.save)
if (!sym->attr.save
&& !(TREE_STATIC (sym->backend_decl) && sym->attr.is_main_program))
{
rank = sym->as ? sym->as->rank : 0;
tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
gfc_add_expr_to_block (&fnblock, tmp);
if (sym->value)
if (sym->value == NULL || !has_default_initializer (sym->ts.u.derived))
{
tmp = gfc_init_default_dt (sym, NULL);
rank = sym->as ? sym->as->rank : 0;
tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
gfc_add_expr_to_block (&fnblock, tmp);
}
else
{
tmp = gfc_init_default_dt (sym, NULL, false);
gfc_add_expr_to_block (&fnblock, tmp);
}
}

23
gcc/fortran/trans-decl.c
View file

@ -1258,9 +1258,15 @@ gfc_get_symbol_decl (gfc_symbol * sym)
if (sym->attr.assign)
gfc_add_assign_aux_vars (sym);
if (TREE_STATIC (decl) && !sym->attr.use_assoc)
if (TREE_STATIC (decl) && !sym->attr.use_assoc
&& (sym->attr.save || sym->ns->proc_name->attr.is_main_program
|| gfc_option.flag_max_stack_var_size == 0
|| sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
{
/* Add static initializer. */
/* Add static initializer. For procedures, it is only needed if
SAVE is specified otherwise they need to be reinitialized
every time the procedure is entered. The TREE_STATIC is
in this case due to -fmax-stack-var-size=. */
DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
TREE_TYPE (decl), sym->attr.dimension,
sym->attr.pointer || sym->attr.allocatable);
@ -2981,9 +2987,10 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
/* Initialize a derived type by building an lvalue from the symbol
and using trans_assignment to do the work. */
and using trans_assignment to do the work. Set dealloc to false
if no deallocation prior the assignment is needed. */
tree
gfc_init_default_dt (gfc_symbol * sym, tree body)
gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc)
{
stmtblock_t fnblock;
gfc_expr *e;
@ -2994,7 +3001,7 @@ gfc_init_default_dt (gfc_symbol * sym, tree body)
gcc_assert (!sym->attr.allocatable);
gfc_set_sym_referenced (sym);
e = gfc_lval_expr_from_sym (sym);
tmp = gfc_trans_assignment (e, sym->value, false);
tmp = gfc_trans_assignment (e, sym->value, false, dealloc);
if (sym->attr.dummy && (sym->attr.optional
|| sym->ns->proc_name->attr.entry_master))
{
@ -3045,7 +3052,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
gfc_add_expr_to_block (&fnblock, tmp);
}
else if (f->sym->value)
body = gfc_init_default_dt (f->sym, body);
body = gfc_init_default_dt (f->sym, body, true);
}
gfc_add_expr_to_block (&fnblock, body);
@ -3148,7 +3155,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
&& sym->value
&& !sym->attr.data
&& sym->attr.save == SAVE_NONE)
fnbody = gfc_init_default_dt (sym, fnbody);
fnbody = gfc_init_default_dt (sym, fnbody, false);
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
@ -3246,7 +3253,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
&& sym->value
&& !sym->attr.data
&& sym->attr.save == SAVE_NONE)
fnbody = gfc_init_default_dt (sym, fnbody);
fnbody = gfc_init_default_dt (sym, fnbody, false);
else
gcc_unreachable ();
}

37
gcc/fortran/trans-expr.c
View file

@ -2386,7 +2386,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
if (intent != INTENT_OUT)
{
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true, false);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true, false, true);
gfc_add_expr_to_block (&body, tmp);
gcc_assert (rse.ss == gfc_ss_terminator);
gfc_trans_scalarizing_loops (&loop, &body);
@ -2484,7 +2484,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
gcc_assert (lse.ss == gfc_ss_terminator);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false, true);
gfc_add_expr_to_block (&body, tmp);
/* Generate the copying loops. */
@ -4111,7 +4111,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
gfc_conv_expr (&rse, expr);
tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false);
tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false, true);
gfc_add_expr_to_block (&body, tmp);
gcc_assert (rse.ss == gfc_ss_terminator);
@ -4369,7 +4369,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
if (cm->ts.type == BT_CHARACTER)
lse.string_length = cm->ts.u.cl->backend_decl;
lse.expr = dest;
tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false);
tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false, true);
gfc_add_expr_to_block (&block, tmp);
}
return gfc_finish_block (&block);
@ -4897,11 +4897,12 @@ gfc_conv_string_parameter (gfc_se * se)
/* Generate code for assignment of scalar variables. Includes character
strings and derived types with allocatable components. */
strings and derived types with allocatable components.
If you know that the LHS has no allocations, set dealloc to false. */
tree
gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
bool l_is_temp, bool r_is_var)
bool l_is_temp, bool r_is_var, bool dealloc)
{
stmtblock_t block;
tree tmp;
@ -4949,7 +4950,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
the same as the rhs. This must be done following the assignment
to prevent deallocating data that could be used in the rhs
expression. */
if (!l_is_temp)
if (!l_is_temp && dealloc)
{
tmp = gfc_evaluate_now (lse->expr, &lse->pre);
tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
@ -5279,10 +5280,13 @@ gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2)
/* Subroutine of gfc_trans_assignment that actually scalarizes the
assignment. EXPR1 is the destination/LHS and EXPR2 is the source/RHS. */
assignment. EXPR1 is the destination/LHS and EXPR2 is the source/RHS.
init_flag indicates initialization expressions and dealloc that no
deallocate prior assignment is needed (if in doubt, set true). */
static tree
gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
bool dealloc)
{
gfc_se lse;
gfc_se rse;
@ -5399,7 +5403,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
&& expr2->expr_type != EXPR_VARIABLE
&& !gfc_is_constant_expr (expr2)
&& expr1->rank && !expr2->rank);
if (scalar_to_array)
if (scalar_to_array && dealloc)
{
tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
gfc_add_expr_to_block (&loop.post, tmp);
@ -5408,7 +5412,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
l_is_temp || init_flag,
(expr2->expr_type == EXPR_VARIABLE)
|| scalar_to_array);
|| scalar_to_array, dealloc);
gfc_add_expr_to_block (&body, tmp);
if (lss == gfc_ss_terminator)
@ -5445,7 +5449,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
rse.string_length = string_length;
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
false, false);
false, false, dealloc);
gfc_add_expr_to_block (&body, tmp);
}
@ -5503,7 +5507,8 @@ copyable_array_p (gfc_expr * expr)
/* Translate an assignment. */
tree
gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
bool dealloc)
{
tree tmp;
@ -5546,19 +5551,19 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
}
/* Fallback to the scalarizer to generate explicit loops. */
return gfc_trans_assignment_1 (expr1, expr2, init_flag);
return gfc_trans_assignment_1 (expr1, expr2, init_flag, dealloc);
}
tree
gfc_trans_init_assign (gfc_code * code)
{
return gfc_trans_assignment (code->expr1, code->expr2, true);
return gfc_trans_assignment (code->expr1, code->expr2, true, false);
}
tree
gfc_trans_assign (gfc_code * code)
{
return gfc_trans_assignment (code->expr1, code->expr2, false);
return gfc_trans_assignment (code->expr1, code->expr2, false, true);
}

10
gcc/fortran/trans-openmp.c
View file

@ -624,11 +624,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
build_int_cst (pvoid_type_node, 0),
size, NULL, NULL);
gfc_conv_descriptor_data_set (&block, decl, ptr);
gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false));
gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false,
false));
stmt = gfc_finish_block (&block);
}
else
stmt = gfc_trans_assignment (e1, e2, false);
stmt = gfc_trans_assignment (e1, e2, false, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
@ -645,12 +646,13 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
stmtblock_t block;
gfc_start_block (&block);
gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false));
gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false,
true));
gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl));
stmt = gfc_finish_block (&block);
}
else
stmt = gfc_trans_assignment (e3, e4, false);
stmt = gfc_trans_assignment (e3, e4, false, true);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else

20
gcc/fortran/trans-stmt.c
View file

@ -1852,7 +1852,7 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post)
}
tmp = gfc_trans_scalar_assign (&tse, &rse, e->ts, true,
e->expr_type == EXPR_VARIABLE);
e->expr_type == EXPR_VARIABLE, true);
gfc_add_expr_to_block (pre, tmp);
}
gfc_free_expr (e);
@ -2216,7 +2216,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
/* Use the scalar assignment. */
rse.string_length = lse.string_length;
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, true, true);
/* Form the mask expression according to the mask tree list. */
if (wheremask)
@ -2314,7 +2314,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
/* Use the scalar assignment. */
lse.string_length = rse.string_length;
tmp = gfc_trans_scalar_assign (&lse, &rse, expr2->ts, true,
expr2->expr_type == EXPR_VARIABLE);
expr2->expr_type == EXPR_VARIABLE, true);
/* Form the mask expression according to the mask tree list. */
if (wheremask)
@ -3091,7 +3091,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
else
{
/* Use the normal assignment copying routines. */
assign = gfc_trans_assignment (c->expr1, c->expr2, false);
assign = gfc_trans_assignment (c->expr1, c->expr2, false, true);
/* Generate body and loops. */
tmp = gfc_trans_nested_forall_loop (nested_forall_info,
@ -3452,7 +3452,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* Use the scalar assignment as is. */
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
loop.temp_ss != NULL, false);
loop.temp_ss != NULL, false, true);
tmp = build3_v (COND_EXPR, maskexpr, tmp, build_empty_stmt (input_location));
@ -3506,7 +3506,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
maskexpr);
/* Use the scalar assignment as is. */
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, false, false);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, false, false,
true);
tmp = build3_v (COND_EXPR, maskexpr, tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&body, tmp);
@ -3913,8 +3914,9 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
gfc_conv_expr (&edse, edst);
}
tstmt = gfc_trans_scalar_assign (&tdse, &tsse, tdst->ts, false, false);
estmt = eblock ? gfc_trans_scalar_assign (&edse, &esse, edst->ts, false, false)
tstmt = gfc_trans_scalar_assign (&tdse, &tsse, tdst->ts, false, false, true);
estmt = eblock ? gfc_trans_scalar_assign (&edse, &esse, edst->ts, false,
false, true)
: build_empty_stmt (input_location);
tmp = build3_v (COND_EXPR, cexpr, tstmt, estmt);
gfc_add_expr_to_block (&body, tmp);
@ -4176,7 +4178,7 @@ gfc_trans_allocate (gfc_code * code)
}
else
tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
rhs, false);
rhs, false, false);
gfc_free_expr (rhs);
gfc_add_expr_to_block (&block, tmp);
}

7
gcc/fortran/trans.h
View file

@ -320,7 +320,8 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);
/* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
/* Generate code for a scalar assignment. */
tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool);
tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
bool);
/* Translate COMMON blocks. */
void gfc_trans_common (gfc_namespace *);
@ -401,7 +402,7 @@ tree gfc_get_symbol_decl (gfc_symbol *);
tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool);
/* Assign a default initializer to a derived type. */
tree gfc_init_default_dt (gfc_symbol *, tree);
tree gfc_init_default_dt (gfc_symbol *, tree, bool);
/* Substitute a temporary variable in place of the real one. */
void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);
@ -485,7 +486,7 @@ tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*);
tree gfc_call_realloc (stmtblock_t *, tree, tree);
/* Generate code for an assignment, includes scalarization. */
tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool);
tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
/* Generate code for a pointer assignment. */
tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *);

7
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,10 @@
2010-04-06 Tobias Burnus <burnus@net-b.de>
PR fortran/43178
* gfortran.dg/alloc_comp_basics_1.f90: Update scan-tree-dump-times.
* gfortran.dg/alloc_comp_constructor_1.f90: Ditto.
* gfortran.dg/auto_dealloc_1.f90: Ditto.
2010-04-06 Richard Guenther <rguenther@suse.de>
PR tree-optimization/43627

2
gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
View file

@ -139,6 +139,6 @@ contains
end subroutine check_alloc2
end program alloc
! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }
! { dg-final { scan-tree-dump-times "builtin_free" 18 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-final { cleanup-modules "alloc_m" } }

2
gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
View file

@ -104,5 +104,5 @@ contains
end function blaha
end program test_constructor
! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }
! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

2
gcc/testsuite/gfortran.dg/auto_dealloc_1.f90
View file

@ -53,7 +53,7 @@ contains
end module
! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } }
! { dg-final { cleanup-modules "automatic_deallocation" } }
! { dg-final { cleanup-tree-dump "original" } }