diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b6d44cd0d20..a861601e0c2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2012-10-04 Tobias Burnus + + * 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 PR fortran/54778 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 4bba438c25e..9ac0fc6858f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 437ed7ec175..0cba9112a08 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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; } diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 6bcd607adc3..fb3da1fb7ba 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -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; diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 428799c1262..447d03f0d50 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -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); } diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index d46a495ae01..06585af94e9 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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; } diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index 12d5b2dcbab..c1196a8802c 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -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) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index f362f75426a..7b64a3c6854 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -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; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3e23ca2e311..7c30cba9756 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 3286a5a6fd6..81b7fa5ca27 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -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