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

expr.c (scalarize_intrinsic_call): Plug memory leak.

Browse source 
2012-10-04  Tobias Burnus  <burnus@net-b.de>

        * expr.c (scalarize_intrinsic_call): Plug memory leak.
        * frontend-passes.c (gcc_assert): Extend assert.
        * interface.c (gfc_compare_derived_types): Fix comparison.
        (gfc_check_operator_interface): Move up to make this error
        message reachable.
        (get_sym_storage_size): Remove always-true checks.
        * io.c (format_lex): Add comment.
        (gfc_free_wait): Free memory.
        * match.c (gfc_match_select_type): Ditto.
        * matchexpr.c (match_level_3): Ditto.
        * primary.c (match_string_constant): Ditto.
        (match_actual_arg): Check return value.
        * resolve.c (gfc_resolve_substring_charlen,
        resolve_typebound_generic_call, resolve_typebound_function,
        resolve_typebound_subroutine): Free memory.
        * trans-types.c (gfc_get_derived_type): Remove always-true
        * check.

From-SVN: r192094
This commit is contained in:
Tobias Burnus 2012-10-04 19:32:06 +02:00 • committed by Tobias Burnus
parent 35057bf736
commit efb63364c5
10 changed files with 66 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
gcc/fortran/ChangeLog
View file

@ -1,3 +1,22 @@
2012-10-04 Tobias Burnus <burnus@net-b.de>
* expr.c (scalarize_intrinsic_call): Plug memory leak.
* frontend-passes.c (gcc_assert): Extend assert.
* interface.c (gfc_compare_derived_types): Fix comparison.
(gfc_check_operator_interface): Move up to make this error
message reachable.
(get_sym_storage_size): Remove always-true checks.
* io.c (format_lex): Add comment.
(gfc_free_wait): Free memory.
* match.c (gfc_match_select_type): Ditto.
* matchexpr.c (match_level_3): Ditto.
* primary.c (match_string_constant): Ditto.
(match_actual_arg): Check return value.
* resolve.c (gfc_resolve_substring_charlen,
resolve_typebound_generic_call, resolve_typebound_function,
resolve_typebound_subroutine): Free memory.
* trans-types.c (gfc_get_derived_type): Remove always-true check.
2012-10-02 Janus Weil <janus@gcc.gnu.org>
PR fortran/54778

2
gcc/fortran/expr.c
View file

@ -2059,6 +2059,8 @@ scalarize_intrinsic_call (gfc_expr *e)
free_expr0 (e);
*e = *expr;
/* Free "expr" but not the pointers it contains. */
free (expr);
gfc_free_expr (old);
return SUCCESS;

2
gcc/fortran/frontend-passes.c
View file

@ -1177,7 +1177,7 @@ optimize_trim (gfc_expr *e)
/* Set the end of the reference to the call to len_trim. */
ref->u.ss.end = fcn;
gcc_assert (*rr == NULL);
gcc_assert (rr != NULL && *rr == NULL);
*rr = ref;
return true;
}

22
gcc/fortran/interface.c
View file

@ -449,7 +449,7 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
/* Make sure that link lists do not put this function into an
endless recursive loop! */
if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
&& !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
&& !(dt2->ts.type == BT_DERIVED && derived2 == dt2->ts.u.derived)
&& gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
return 0;
@ -641,8 +641,12 @@ gfc_check_operator_interface (gfc_symbol *sym, gfc_intrinsic_op op,
&& op != INTRINSIC_NOT)
|| (args == 2 && op == INTRINSIC_NOT))
{
gfc_error ("Operator interface at %L has the wrong number of arguments",
&sym->declared_at);
if (op == INTRINSIC_ASSIGN)
gfc_error ("Assignment operator interface at %L must have "
"two arguments", &sym->declared_at);
else
gfc_error ("Operator interface at %L has the wrong number of arguments",
&sym->declared_at);
return false;
}
@ -656,12 +660,6 @@ gfc_check_operator_interface (gfc_symbol *sym, gfc_intrinsic_op op,
"a SUBROUTINE", &sym->declared_at);
return false;
}
if (args != 2)
{
gfc_error ("Assignment operator interface at %L must have "
"two arguments", &sym->declared_at);
return false;
}
/* Allowed are (per F2003, 12.3.2.1.2 Defined assignments):
- First argument an array with different rank than second,
@ -2149,7 +2147,7 @@ get_sym_storage_size (gfc_symbol *sym)
return 0;
for (i = 0; i < sym->as->rank; i++)
{
if (!sym->as || sym->as->upper[i]->expr_type != EXPR_CONSTANT
if (sym->as->upper[i]->expr_type != EXPR_CONSTANT
|| sym->as->lower[i]->expr_type != EXPR_CONSTANT)
return 0;
@ -2224,9 +2222,7 @@ get_expr_storage_size (gfc_expr *e)
continue;
}
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION
&& ref->u.ar.start && ref->u.ar.end && ref->u.ar.stride
&& ref->u.ar.as->upper)
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
for (i = 0; i < ref->u.ar.dimen; i++)
{
long int start, end, stride;

3
gcc/fortran/io.c
View file

@ -243,6 +243,8 @@ format_lex (void)
{
case '-':
negative_flag = 1;
/* Falls through. */
case '+':
c = next_char_not_space (&error);
if (!ISDIGIT (c))
@ -4117,6 +4119,7 @@ gfc_free_wait (gfc_wait *wait)
gfc_free_expr (wait->iostat);
gfc_free_expr (wait->iomsg);
gfc_free_expr (wait->id);
free (wait);
}

5
gcc/fortran/match.c
View file

@ -5325,6 +5325,7 @@ gfc_match_select_type (void)
char name[GFC_MAX_SYMBOL_LEN];
bool class_array;
gfc_symbol *sym;
gfc_namespace *parent_ns;
m = gfc_match_label ();
if (m == MATCH_ERROR)
@ -5404,7 +5405,9 @@ gfc_match_select_type (void)
return MATCH_YES;
cleanup:
gfc_current_ns = gfc_current_ns->parent;
parent_ns = gfc_current_ns->parent;
gfc_free_namespace (gfc_current_ns);
gfc_current_ns = parent_ns;
return m;
}

12
gcc/fortran/matchexp.c
View file

@ -543,7 +543,7 @@ match_level_2 (gfc_expr **result)
static match
match_level_3 (gfc_expr **result)
{
gfc_expr *all, *e, *total;
gfc_expr *all, *e, *total = NULL;
locus where;
match m;
@ -560,12 +560,12 @@ match_level_3 (gfc_expr **result)
m = match_level_2 (&e);
if (m == MATCH_NO)
{
gfc_error (expression_syntax);
gfc_free_expr (all);
}
gfc_error (expression_syntax);
if (m != MATCH_YES)
return MATCH_ERROR;
{
gfc_free_expr (all);
return MATCH_ERROR;
}
total = gfc_concat (all, e);
if (total == NULL)

6
gcc/fortran/primary.c
View file

@ -1087,6 +1087,7 @@ got_delim:
if (!gfc_check_character_range (c, kind))
{
gfc_free_expr (e);
gfc_error ("Character '%s' in string at %C is not representable "
"in character kind %d", gfc_print_wide_char (c), kind);
return MATCH_ERROR;
@ -1507,8 +1508,9 @@ match_actual_arg (gfc_expr **result)
if (sym->attr.in_common && !sym->attr.proc_pointer)
{
gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name,
&sym->declared_at);
if (gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name,
&sym->declared_at) == FAILURE)
return MATCH_ERROR;
break;
}

21
gcc/fortran/resolve.c
View file

@ -4964,7 +4964,11 @@ gfc_resolve_substring_charlen (gfc_expr *e)
end = NULL;
if (!start || !end)
return;
{
gfc_free_expr (start);
gfc_free_expr (end);
return;
}
/* Length = (end - start +1). */
e->ts.u.cl->length = gfc_subtract (end, start);
@ -6004,7 +6008,10 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name)
gfc_expr* po;
po = extract_compcall_passed_object (e);
if (!po)
return FAILURE;
{
gfc_free_actual_arglist (args);
return FAILURE;
}
gcc_assert (g->specific->pass_arg_num > 0);
gcc_assert (!g->specific->error);
@ -6253,7 +6260,10 @@ resolve_typebound_function (gfc_expr* e)
/* Treat the call as if it is a typebound procedure, in order to roll
out the correct name for the specific function. */
if (resolve_compcall (e, &name) == FAILURE)
return FAILURE;
{
gfc_free_ref_list (new_ref);
return FAILURE;
}
ts = e->ts;
if (overridable)
@ -6374,7 +6384,10 @@ resolve_typebound_subroutine (gfc_code *code)
}
if (resolve_typebound_call (code, &name) == FAILURE)
return FAILURE;
{
gfc_free_ref_list (new_ref);
return FAILURE;
}
ts = code->expr1->ts;
if (overridable)

2
gcc/fortran/trans-types.c
View file

@ -2445,7 +2445,7 @@ gfc_get_derived_type (gfc_symbol * derived)
|| c->ts.u.derived->backend_decl == NULL)
c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived);
if (c->ts.u.derived && c->ts.u.derived->attr.is_iso_c)
if (c->ts.u.derived->attr.is_iso_c)
{
/* Need to copy the modified ts from the derived type. The
typespec was modified because C_PTR/C_FUNPTR are translated