Patchwork [Fortran,committed] Plug some memory leaks

login
register
mail settings
Submitter Tobias Burnus
Date April 18, 2013, 7 p.m.
Message ID <517042C0.2090804@net-b.de>
Download mbox | patch
Permalink /patch/237719/
State New
Headers show

Comments

Tobias Burnus - April 18, 2013, 7 p.m.
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

Patch

2013-04-18  Tobias Burnus  <burnus@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;