2012-09-15 Tobias Burnus <burnus@net-b.de>

        * arith.c (arith_power): Call gfc_free_expr in case of error.
        * array.c (gfc_match_array_constructor): Initialize variable.
        (gfc_resolve_character_array_constructor): Remove superfluous check.
        (gfc_array_dimen_size): Add assert.
        * check.c (numeric_check): Fix implicit typing.
        * class.c (gfc_build_class_symbol): Add assert.
        (finalize_component): Free memory.
        * dump-parse-tree.c (show_namespace): Add assert.
        * trans-io.c (transfer_namelist_element, transfer_expr): Avoid
        memory leakage.
        (gfc_trans_transfer): Add assert.
        * trans.c (gfc_trans_runtime_check): Call va_end



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@191344 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 82 insertions, 55 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a1a2cd2dd53..4625c622807 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,20 @@
 2012-09-15  Tobias Burnus  <burnus@net-b.de>
 
+	* arith.c (arith_power): Call gfc_free_expr in case of error.
+	* array.c (gfc_match_array_constructor): Initialize variable.
+	(gfc_resolve_character_array_constructor): Remove superfluous check.
+	(gfc_array_dimen_size): Add assert.
+	* check.c (numeric_check): Fix implicit typing.
+	* class.c (gfc_build_class_symbol): Add assert.
+	(finalize_component): Free memory.
+	* dump-parse-tree.c (show_namespace): Add assert.
+	* trans-io.c (transfer_namelist_element, transfer_expr): Avoid
+	memory leakage.
+	(gfc_trans_transfer): Add assert.
+	* trans.c (gfc_trans_runtime_check): Call va_end
+
+2012-09-15  Tobias Burnus  <burnus@net-b.de>
+
 	* match.c (lock_unlock_statement, sync_statement): Fix potential
 	double freeing.
 	(sync_statement): Remove unreachable code.
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 6fa7c70fe9c..e94566aa65c 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -906,7 +906,10 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 	  if (gfc_notify_std (GFC_STD_F2003, "Noninteger "
 			      "exponent in an initialization "
 			      "expression at %L", &op2->where) == FAILURE)
-	    return ARITH_PROHIBIT;
+	    {
+	      gfc_free_expr (result);
+	      return ARITH_PROHIBIT;
+	    }
 	}
 
       if (mpfr_cmp_si (op1->value.real, 0) < 0)
@@ -928,7 +931,10 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 	    if (gfc_notify_std (GFC_STD_F2003, "Noninteger "
 				"exponent in an initialization "
 				"expression at %L", &op2->where) == FAILURE)
-	      return ARITH_PROHIBIT;
+	      {
+		gfc_free_expr (result);
+		return ARITH_PROHIBIT;
+	      }
 	  }
 
 	mpc_pow (result->value.complex, op1->value.complex,
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 44ec72eb87c..066ac1ea902 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1074,6 +1074,7 @@ gfc_match_array_constructor (gfc_expr **result)
   seen_ts = false;
 
   /* Try to match an optional "type-spec ::"  */
+  gfc_clear_ts (&ts);
   if (gfc_match_decl_type_spec (&ts, 0) == MATCH_YES)
     {
       seen_ts = (gfc_match (" ::") == MATCH_YES);
@@ -1973,7 +1974,7 @@ got_charlen:
 	      /* If gfc_extract_int above set current_length, we implicitly
 		 know the type is BT_INTEGER and it's EXPR_CONSTANT.  */
 
-	      has_ts = (expr->ts.u.cl && expr->ts.u.cl->length_from_typespec);
+	      has_ts = expr->ts.u.cl->length_from_typespec;
 
 	      if (! cl
 		  || (current_length != -1 && current_length != found_length))
@@ -2225,13 +2226,15 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
   gfc_ref *ref;
   int i;
 
+  gcc_assert (array != NULL);
+
   if (array->ts.type == BT_CLASS)
     return FAILURE;
 
   if (array->rank == -1)
     return FAILURE;
 
-  if (dimen < 0 || array == NULL || dimen > array->rank - 1)
+  if (dimen < 0 || dimen > array->rank - 1)
     gfc_internal_error ("gfc_array_dimen_size(): Bad dimension");
 
   switch (array->expr_type)
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 2235b52d6d3..58c5856795d 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -79,7 +79,7 @@ numeric_check (gfc_expr *e, int n)
 
   /* If the expression has not got a type, check if its namespace can
      offer a default type.  */
-  if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_VARIABLE)
+  if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION)
 	&& e->symtree->n.sym->ts.type == BT_UNKNOWN
 	&& gfc_set_default_type (e->symtree->n.sym, 0,
 				 e->symtree->n.sym->ns) == SUCCESS
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index dca2cfc1cda..2e347cb8670 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -503,7 +503,9 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
   gfc_component *c;
   int rank;
 
-  if (as && *as && (*as)->type == AS_ASSUMED_SIZE)
+  gcc_assert (as);
+
+  if (*as && (*as)->type == AS_ASSUMED_SIZE)
     {
       gfc_error ("Assumed size polymorphic objects or components, such "
 		 "as that at %C, have not yet been implemented");
@@ -838,6 +840,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
 
       for (c = comp->ts.u.derived->components; c; c = c->next)
 	finalize_component (e, c->ts.u.derived, c, stat, code);
+      gfc_free_expr (e);
     }
 }
 
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 9d6f93c5f77..a442625cb8a 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -2248,67 +2248,63 @@ show_namespace (gfc_namespace *ns)
   gfc_equiv *eq;
   int i;
 
+  gcc_assert (ns);
   save = gfc_current_ns;
 
   show_indent ();
   fputs ("Namespace:", dumpfile);
 
-  if (ns != NULL)
+  i = 0;
+  do
     {
-      i = 0;
-      do
-	{
-	  int l = i;
-	  while (i < GFC_LETTERS - 1
-		 && gfc_compare_types(&ns->default_type[i+1],
-				      &ns->default_type[l]))
-	    i++;
-
-	  if (i > l)
-	    fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
-	  else
-	    fprintf (dumpfile, " %c: ", l+'A');
+      int l = i;
+      while (i < GFC_LETTERS - 1
+	     && gfc_compare_types (&ns->default_type[i+1],
+				   &ns->default_type[l]))
+	i++;
+
+      if (i > l)
+	fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
+      else
+	fprintf (dumpfile, " %c: ", l+'A');
 
-	  show_typespec(&ns->default_type[l]);
-	  i++;
-      } while (i < GFC_LETTERS);
+      show_typespec(&ns->default_type[l]);
+      i++;
+    } while (i < GFC_LETTERS);
 
-      if (ns->proc_name != NULL)
-	{
-	  show_indent ();
-	  fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
-	}
+  if (ns->proc_name != NULL)
+    {
+      show_indent ();
+      fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
+    }
 
-      ++show_level;
-      gfc_current_ns = ns;
-      gfc_traverse_symtree (ns->common_root, show_common);
+  ++show_level;
+  gfc_current_ns = ns;
+  gfc_traverse_symtree (ns->common_root, show_common);
 
-      gfc_traverse_symtree (ns->sym_root, show_symtree);
+  gfc_traverse_symtree (ns->sym_root, show_symtree);
 
-      for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
-	{
-	  /* User operator interfaces */
-	  intr = ns->op[op];
-	  if (intr == NULL)
-	    continue;
+  for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
+    {
+      /* User operator interfaces */
+      intr = ns->op[op];
+      if (intr == NULL)
+	continue;
 
-	  show_indent ();
-	  fprintf (dumpfile, "Operator interfaces for %s:",
-		   gfc_op2string ((gfc_intrinsic_op) op));
+      show_indent ();
+      fprintf (dumpfile, "Operator interfaces for %s:",
+	       gfc_op2string ((gfc_intrinsic_op) op));
 
-	  for (; intr; intr = intr->next)
-	    fprintf (dumpfile, " %s", intr->sym->name);
-	}
+      for (; intr; intr = intr->next)
+	fprintf (dumpfile, " %s", intr->sym->name);
+    }
 
-      if (ns->uop_root != NULL)
-	{
-	  show_indent ();
-	  fputs ("User operators:\n", dumpfile);
-	  gfc_traverse_user_op (ns, show_uop);
-	}
+  if (ns->uop_root != NULL)
+    {
+      show_indent ();
+      fputs ("User operators:\n", dumpfile);
+      gfc_traverse_user_op (ns, show_uop);
     }
-  else
-    ++show_level;
   
   for (eq = ns->equiv; eq; eq = eq->next)
     show_equiv (eq);
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 34db6fd5a11..e607e2debe5 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1611,7 +1611,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
       gfc_add_expr_to_block (block, tmp);
     }
 
-  if (ts->type == BT_DERIVED)
+  if (ts->type == BT_DERIVED && ts->u.derived->components)
     {
       gfc_component *cmp;
 
@@ -2146,6 +2146,9 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       break;
 
     case BT_DERIVED:
+      if (ts->u.derived->components == NULL)
+	return;
+
       /* Recurse into the elements of the derived type.  */
       expr = gfc_evaluate_now (addr_expr, &se->pre);
       expr = build_fold_indirect_ref_loc (input_location,
@@ -2251,8 +2254,8 @@ gfc_trans_transfer (gfc_code * code)
       if (expr->ref && !gfc_is_proc_ptr_comp (expr))
 	{
 	  for (ref = expr->ref; ref && ref->type != REF_ARRAY;
-		 ref = ref->next);
-	  gcc_assert (ref->type == REF_ARRAY);
+	    ref = ref->next);
+	  gcc_assert (ref && ref->type == REF_ARRAY);
 	}
 
       if (expr->ts.type != BT_DERIVED
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ff0b243a202..6365213b8f0 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -506,6 +506,7 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   gfc_add_expr_to_block (&block,
 			 trans_runtime_error_vararg (error, where,
 						     msgid, ap));
+  va_end (ap);
 
   if (once)
     gfc_add_modify (&block, tmpvar, boolean_false_node);