From 99c25a87c6bd63d6b03e3792630ae61c166dcac9 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 23 Sep 2012 08:48:48 +0200 Subject: [PATCH] re PR fortran/54599 (Issues found in gfortran by the Coverity Scan) 2012-09-23 Tobias Burnus * 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 PR fortran/54618 * gfortran.dg/class_array_14.f90: New. From-SVN: r191649 --- gcc/fortran/ChangeLog | 18 +++++++ gcc/fortran/parse.c | 3 +- gcc/fortran/resolve.c | 2 +- gcc/fortran/simplify.c | 5 +- gcc/fortran/trans-array.c | 4 +- gcc/fortran/trans-expr.c | 38 ++++++++++++-- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/class_array_14.f90 | 53 ++++++++++++++++++++ 8 files changed, 116 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_array_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 983d305419d..1be83d418b2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2012-09-23 Tobias Burnus + + * 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-22 Thomas König PR fortran/54599 diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 5c5d38176c3..f31e30940b8 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2195,7 +2195,8 @@ endType: if (c->attr.allocatable || (c->ts.type == BT_CLASS && c->attr.class_ok && CLASS_DATA (c)->attr.allocatable) - || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp)) + || (c->ts.type == BT_DERIVED && !c->attr.pointer + && c->ts.u.derived->attr.alloc_comp)) { allocatable = true; sym->attr.alloc_comp = 1; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f67c07f8b7b..0a20540b6da 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12478,7 +12478,7 @@ resolve_fl_namelist (gfc_symbol *sym) continue; nlsym = NULL; - if (nl->sym && nl->sym->name) + if (nl->sym->name) gfc_find_symbol (nl->sym->name, sym->ns, 1, &nlsym); if (nlsym && nlsym->attr.flavor == FL_PROCEDURE) { diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 1c9dff23410..2f96e900bf1 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -4106,10 +4106,7 @@ simplify_min_max (gfc_expr *expr, int sign) min_max_choose (arg->expr, extremum->expr, sign); /* Delete the extra constant argument. */ - if (last == NULL) - expr->value.function.actual = arg->next; - else - last->next = arg->next; + last->next = arg->next; arg->next = NULL; gfc_free_actual_arglist (arg); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c350c3b5e3a..3e684ee6649 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1022,8 +1022,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, dynamic type. Generate an eltype and then the class expression. */ if (eltype == NULL_TREE && initial) { - if (POINTER_TYPE_P (TREE_TYPE (initial))) - class_expr = build_fold_indirect_ref_loc (input_location, initial); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (initial))); + class_expr = build_fold_indirect_ref_loc (input_location, initial); eltype = TREE_TYPE (class_expr); eltype = gfc_get_element_type (eltype); /* Obtain the structure (class) expression. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 98634c3e13f..177d2865b81 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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3f842da7469..7b18d990630 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-09-2323 Tobias Burnus + + PR fortran/54618 + * gfortran.dg/class_array_14.f90: New. + 2012-09-22 Kai Tietz * gcc.dg/tree-ssa/scev-3.c: Add llp64 to xfail. diff --git a/gcc/testsuite/gfortran.dg/class_array_14.f90 b/gcc/testsuite/gfortran.dg/class_array_14.f90 new file mode 100644 index 00000000000..ad227a9074c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_array_14.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! +! PR fortran/54618 +! +! Check whether default initialization works with INTENT(OUT) +! and ALLOCATABLE and no segfault occurs with OPTIONAL. +! + +subroutine test1() + type typ1 + integer :: i = 6 + end type typ1 + + type(typ1) :: x + + x%i = 77 + call f(x) + if (x%i /= 6) call abort () + call f() +contains + subroutine f(y1) + class(typ1), intent(out), optional :: y1 + end subroutine f +end subroutine test1 + +subroutine test2() + type mytype + end type mytype + type, extends(mytype):: mytype2 + end type mytype2 + + class(mytype), allocatable :: x,y + allocate (mytype2 :: x) + call g(x) + if (allocated (x) .or. .not. same_type_as (x,y)) call abort() + + allocate (mytype2 :: x) + call h(x) + if (allocated (x) .or. .not. same_type_as (x,y)) call abort() + + call h() +contains + subroutine g(y2) + class(mytype), intent(out), allocatable :: y2 + end subroutine g + subroutine h(y3) + class(mytype), optional, intent(out), allocatable :: y3 + end subroutine h +end subroutine test2 + +call test1() +call test2() +end -- 2.30.2