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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b6d44cd0d202fe84c6fc410959a6824c9c24669a..a861601e0c2957b48f0d7ac4c36c6d7cc89de056 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 4bba438c25e051f323fa2ef1641e11c415604605..9ac0fc6858f96b5496a6eb00980e4e9281f23a7a 100644 (file)
--- 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 437ed7ec1757d0da422fc5665ee394a0cf1a2b20..0cba9112a08811c492c50ae3769c00e2106f03bc 100644 (file)
--- 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 6bcd607adc362666dbd880a7f8e944e948ee8a6f..fb3da1fb7baa88100d2e8004aa2ec50db9422ebd 100644 (file)
--- 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 428799c1262ff15f4bfabdc84277bb5ceb8e9f89..447d03f0d503514c2d30c65aed12d09df14fdae8 100644 (file)
--- 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 d46a495ae01cd20eaa72fc037ce91d65d8942e13..06585af94e99331ed38d5d774e197af80d266f0e 100644 (file)
--- 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 12d5b2dcbaba46c3c0902d6d14a352bf9e40d885..c1196a8802c015baa675701f05b0ed8faeb4d8bc 100644 (file)
--- 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);
+      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)

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index f362f75426aa85ccab90a5d58de1f009e7447516..7b64a3c6854e240cac78a90ce02234c00c753c1f 100644 (file)
--- 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 3e23ca2e31128d736a8034a2429e3fc130368b6a..7c30cba9756d33ca65ee2525f6d13d42befa5012 100644 (file)
--- 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 3286a5a6fd641df3985416a1d31ec338ace758d4..81b7fa5ca27f8515b633cdd92023d1415af4134c 100644 (file)
--- 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