aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2012-09-23 08:48:48 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2012-09-23 08:48:48 +0200
commit99c25a87c6bd63d6b03e3792630ae61c166dcac9 (patch)
tree6fb6edff03b3f9b88751aee4639a84d409c9b04f /gcc/fortran
parent8856695d70f0c622d7154e95b52cd758f77c7e2c (diff)
downloadgcc-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')
-rw-r--r--gcc/fortran/ChangeLog18
-rw-r--r--gcc/fortran/parse.c3
-rw-r--r--gcc/fortran/resolve.c2
-rw-r--r--gcc/fortran/simplify.c5
-rw-r--r--gcc/fortran/trans-array.c4
-rw-r--r--gcc/fortran/trans-expr.c38
6 files changed, 58 insertions, 12 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 983d305..1be83d4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+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-22 Thomas König <tkoenig@gcc.gnu.org>
PR fortran/54599
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 5c5d381..f31e309 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 f67c07f..0a20540 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 1c9dff2..2f96e90 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 c350c3b..3e684ee 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 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)