expr.c (scalarize_intrinsic_call): Plug memory leak.

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

gcc/fortran/ChangeLog

+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

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;
 

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;
 }

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;

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);
 }
 
 

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;
 }
 

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);
+      if (m != MATCH_YES)
 	{
-	  gfc_error (expression_syntax);
 	  gfc_free_expr (all);
+	  return MATCH_ERROR;
 	}
-      if (m != MATCH_YES)
-	return MATCH_ERROR;
 
       total = gfc_concat (all, e);
       if (total == NULL)

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;
 	    }
 

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)

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