Another batch of issues found by Coverity - this time only memory leaks.
Committed as Rev. 198068 after build + regtesting on x86-64-gnu-linux.
Tobias
2013-04-18 Tobias Burnus <bur...@net-b.de>
* expr.c (find_array_element): Don't copy expr.
* data.c (create_character_initializer): Free expr.
* frontend-passes.c (combine_array_constructor): Ditto.
* match.c (match_typebound_call, gfc_match_select_type): Ditto.
* resolve.c (resolve_typebound_function): Free gfc_ref.
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index f297ef5..a1c89fa 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -93,60 +93,66 @@ find_con_by_component (gfc_component *com, gfc_constructor_base base)
return NULL;
}
/* Create a character type initialization expression from RVALUE.
TS [and REF] describe [the substring of] the variable being initialized.
INIT is the existing initializer, not NULL. Initialization is performed
according to normal assignment rules. */
static gfc_expr *
create_character_initializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue)
{
int len, start, end;
gfc_char_t *dest;
+ bool alloced_init = false;
gfc_extract_int (ts->u.cl->length, &len);
if (init == NULL)
{
/* Create a new initializer. */
init = gfc_get_character_expr (ts->kind, NULL, NULL, len);
init->ts = *ts;
+ alloced_init = true;
}
dest = init->value.character.string;
if (ref)
{
gfc_expr *start_expr, *end_expr;
gcc_assert (ref->type == REF_SUBSTRING);
/* Only set a substring of the destination. Fortran substring bounds
are one-based [start, end], we want zero based [start, end). */
start_expr = gfc_copy_expr (ref->u.ss.start);
end_expr = gfc_copy_expr (ref->u.ss.end);
if ((!gfc_simplify_expr(start_expr, 1))
|| !(gfc_simplify_expr(end_expr, 1)))
{
gfc_error ("failure to simplify substring reference in DATA "
"statement at %L", &ref->u.ss.start->where);
+ gfc_free_expr (start_expr);
+ gfc_free_expr (end_expr);
+ if (alloced_init)
+ gfc_free_expr (init);
return NULL;
}
gfc_extract_int (start_expr, &start);
gfc_free_expr (start_expr);
start--;
gfc_extract_int (end_expr, &end);
gfc_free_expr (end_expr);
}
else
{
/* Set the whole string. */
start = 0;
end = len;
}
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 490cdaa..ab62c18 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1196,33 +1196,33 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar,
e = NULL;
mpz_init_set_ui (offset, 0);
mpz_init (delta);
mpz_init (tmp);
mpz_init_set_ui (span, 1);
for (i = 0; i < ar->dimen; i++)
{
if (!gfc_reduce_init_expr (ar->as->lower[i])
|| !gfc_reduce_init_expr (ar->as->upper[i]))
{
t = false;
cons = NULL;
goto depart;
}
- e = gfc_copy_expr (ar->start[i]);
+ e = ar->start[i];
if (e->expr_type != EXPR_CONSTANT)
{
cons = NULL;
goto depart;
}
gcc_assert (ar->as->upper[i]->expr_type == EXPR_CONSTANT
&& ar->as->lower[i]->expr_type == EXPR_CONSTANT);
/* Check the bounds. */
if ((ar->as->upper[i]
&& mpz_cmp (e->value.integer,
ar->as->upper[i]->value.integer) > 0)
|| (mpz_cmp (e->value.integer,
ar->as->lower[i]->value.integer) < 0))
{
@@ -1245,34 +1245,32 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar,
for (cons = gfc_constructor_first (base), nelemen = mpz_get_ui (offset);
cons && nelemen > 0; cons = gfc_constructor_next (cons), nelemen--)
{
if (cons->iterator)
{
cons = NULL;
goto depart;
}
}
depart:
mpz_clear (delta);
mpz_clear (offset);
mpz_clear (span);
mpz_clear (tmp);
- if (e)
- gfc_free_expr (e);
*rval = cons;
return t;
}
/* Find a component of a structure constructor. */
static gfc_constructor *
find_component_ref (gfc_constructor_base base, gfc_ref *ref)
{
gfc_component *comp;
gfc_component *pick;
gfc_constructor *c = gfc_constructor_first (base);
comp = ref->u.c.sym->components;
pick = ref->u.c.component;
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 3946c0c..68e7e05 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -1060,32 +1060,33 @@ combine_array_constructor (gfc_expr *e)
new_expr->value.op.op1 = gfc_copy_expr (scalar);
new_expr->value.op.op2 = gfc_copy_expr (c->expr);
}
else
{
new_expr->value.op.op1 = gfc_copy_expr (c->expr);
new_expr->value.op.op2 = gfc_copy_expr (scalar);
}
new_c = gfc_constructor_append_expr (&newbase, new_expr, &(e->where));
new_c->iterator = c->iterator;
c->iterator = NULL;
}
gfc_free_expr (op1);
gfc_free_expr (op2);
+ gfc_free_expr (scalar);
e->value.constructor = newbase;
return true;
}
/* Recursive optimization of operators. */
static bool
optimize_op (gfc_expr *e)
{
bool changed;
gfc_intrinsic_op op = e->value.op.op;
changed = false;
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index b5e9609..07f8f63 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4064,48 +4064,53 @@ done:
static match
match_typebound_call (gfc_symtree* varst)
{
gfc_expr* base;
match m;
base = gfc_get_expr ();
base->expr_type = EXPR_VARIABLE;
base->symtree = varst;
base->where = gfc_current_locus;
gfc_set_sym_referenced (varst->n.sym);
m = gfc_match_varspec (base, 0, true, true);
if (m == MATCH_NO)
gfc_error ("Expected component reference at %C");
if (m != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_free_expr (base);
+ return MATCH_ERROR;
+ }
if (gfc_match_eos () != MATCH_YES)
{
gfc_error ("Junk after CALL at %C");
+ gfc_free_expr (base);
return MATCH_ERROR;
}
if (base->expr_type == EXPR_COMPCALL)
new_st.op = EXEC_COMPCALL;
else if (base->expr_type == EXPR_PPC)
new_st.op = EXEC_CALL_PPC;
else
{
gfc_error ("Expected type-bound procedure or procedure pointer component "
"at %C");
+ gfc_free_expr (base);
return MATCH_ERROR;
}
new_st.expr1 = base;
return MATCH_YES;
}
/* Match a CALL statement. The tricky part here are possible
alternate return specifiers. We handle these by having all
"subroutines" actually return an integer via a register that gives
the return number. If the call specifies alternate returns, we
generate code for a SELECT statement whose case clauses contain
GOTOs to the various labels. */
match
@@ -5358,33 +5363,33 @@ gfc_match_select_type (void)
}
sym = expr1->symtree->n.sym;
if (expr2->ts.type == BT_UNKNOWN)
sym->attr.untyped = 1;
else
copy_ts_from_selector_to_associate (expr1, expr2);
sym->attr.flavor = FL_VARIABLE;
sym->attr.referenced = 1;
sym->attr.class_ok = 1;
}
else
{
m = gfc_match (" %e ", &expr1);
if (m != MATCH_YES)
- goto cleanup;
+ return m;
}
m = gfc_match (" )%t");
if (m != MATCH_YES)
{
gfc_error ("parse error in SELECT TYPE statement at %C");
goto cleanup;
}
/* This ghastly expression seems to be needed to distinguish a CLASS
array, which can have a reference, from other expressions that
have references, such as derived type components, and are not
allowed by the standard.
TODO: see if it is sufficient to exclude component and substring
references. */
class_array = expr1->expr_type == EXPR_VARIABLE
@@ -5404,32 +5409,34 @@ gfc_match_select_type (void)
gfc_error ("Selector in SELECT TYPE at %C is not a named variable; "
"use associate-name=>");
m = MATCH_ERROR;
goto cleanup;
}
new_st.op = EXEC_SELECT_TYPE;
new_st.expr1 = expr1;
new_st.expr2 = expr2;
new_st.ext.block.ns = gfc_current_ns;
select_type_push (expr1->symtree->n.sym);
return MATCH_YES;
cleanup:
+ gfc_free_expr (expr1);
+ gfc_free_expr (expr2);
return m;
}
/* Match a CASE statement. */
match
gfc_match_case (void)
{
gfc_case *c, *head, *tail;
match m;
head = tail = NULL;
if (gfc_current_state () != COMP_SELECT)
{
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 90bce53..6e1f56f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5706,32 +5706,34 @@ resolve_typebound_function (gfc_expr* e)
e->value.function.esym = NULL;
e->symtree = st;
if (new_ref)
e->ref = new_ref;
/* '_vptr' points to the vtab, which contains the procedure pointers. */
gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
/* Recover the typespec for the expression. This is really only
necessary for generic procedures, where the additional call
to gfc_add_component_ref seems to throw the collection of the
correct typespec. */
e->ts = ts;
}
+ else if (new_ref)
+ gfc_free_ref_list (new_ref);
return true;
}
/* Resolve a typebound subroutine, or 'method'. First separate all
the non-CLASS references by calling resolve_typebound_call
directly. */
static bool
resolve_typebound_subroutine (gfc_code *code)
{
gfc_symbol *declared;
gfc_component *c;
gfc_ref *new_ref;
gfc_ref *class_ref;
gfc_symtree *st;
