diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-09-23 08:48:48 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-09-23 08:48:48 +0200 |
| commit | 99c25a87c6bd63d6b03e3792630ae61c166dcac9 (patch) | |
| tree | 6fb6edff03b3f9b88751aee4639a84d409c9b04f /gcc/fortran/trans-expr.c | |
| parent | 8856695d70f0c622d7154e95b52cd758f77c7e2c (diff) | |
| download | gcc-99c25a87c6bd63d6b03e3792630ae61c166dcac9.zip gcc-99c25a87c6bd63d6b03e3792630ae61c166dcac9.tar.gz gcc-99c25a87c6bd63d6b03e3792630ae61c166dcac9.tar.bz2 | |
re PR fortran/54599 (Issues found in gfortran by the Coverity Scan)
2012-09-23 Tobias Burnus <burnus@net-b.de>
* parse.c (parse_derived): Don't set attr.alloc_comp
for pointer components with allocatable subcomps.
PR fortran/54599
* resolve.c (resolve_fl_namelist): Remove superfluous
NULL check.
* simplify.c (simplify_min_max): Remove unreachable code.
* trans-array.c (gfc_trans_create_temp_array): Change
a condition into an assert.
PR fortran/54618
* trans-expr.c (gfc_trans_class_init_assign): Guard
re-setting of the _data by gfc_conv_expr_present.
(gfc_conv_procedure_call): Fix INTENT(OUT) handling
for allocatable BT_CLASS.
2012-09-23 Tobias Burnus <burnus@net-b.de>
PR fortran/54618
* gfortran.dg/class_array_14.f90: New.
From-SVN: r191649
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 38 |
1 files changed, 34 insertions, 4 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 98634c3..177d286 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -621,6 +621,16 @@ gfc_trans_class_init_assign (gfc_code *code) gfc_add_block_to_block (&block, &src.pre); tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr); } + + if (code->expr1->symtree->n.sym->attr.optional + || code->expr1->symtree->n.sym->ns->proc_name->attr.entry_master) + { + tree present = gfc_conv_expr_present (code->expr1->symtree->n.sym); + tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), + present, tmp, + build_empty_stmt (input_location)); + } + gfc_add_expr_to_block (&block, tmp); return gfc_finish_block (&block); @@ -3905,22 +3915,42 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ - if (fsym && fsym->attr.allocatable - && fsym->attr.intent == INTENT_OUT) + if (fsym && fsym->attr.intent == INTENT_OUT + && (fsym->attr.allocatable + || (fsym->ts.type == BT_CLASS + && CLASS_DATA (e)->attr.allocatable))) { stmtblock_t block; + tree ptr; gfc_init_block (&block); - tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE, + ptr = parmse.expr; + if (e->ts.type == BT_CLASS) + ptr = gfc_class_data_get (ptr); + + tmp = gfc_deallocate_with_status (ptr, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, true, NULL, false); gfc_add_expr_to_block (&block, tmp); tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, parmse.expr, + void_type_node, ptr, null_pointer_node); gfc_add_expr_to_block (&block, tmp); + if (fsym->ts.type == BT_CLASS) + { + gfc_symbol *vtab; + gcc_assert (fsym->ts.u.derived == e->ts.u.derived); + vtab = gfc_find_derived_vtab (fsym->ts.u.derived); + tmp = gfc_get_symbol_decl (vtab); + tmp = gfc_build_addr_expr (NULL_TREE, tmp); + ptr = gfc_class_vptr_get (parmse.expr); + gfc_add_modify (&block, ptr, + fold_convert (TREE_TYPE (ptr), tmp)); + gfc_add_expr_to_block (&block, tmp); + } + if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) |