Patchwork [Fortran] Fix some issues found by Coverity's static-code analysis scan

login
register
mail settings
Submitter Tobias Burnus
Date Sept. 15, 2012, 9:46 a.m.
Message ID <50544E8A.5040704@net-b.de>
Download mbox | patch
Permalink /patch/184074/
State New
Headers show

Comments

Tobias Burnus - Sept. 15, 2012, 9:46 a.m.
Dear all,

this patch fixes some of the warning showing up for gcc/fortran at 
http://scan.coverity.com/. Coverity sells static C/C++/C#/Java code 
analyzers and offer scanning to open-source projects. The result looks 
like 
http://www.coverity.com/images/products/static-analysis/screenshot-1-large.png

For GCC with a C,C++,Fortran,LTO build it shows 12,000 "defects", many 
are false positives, e.g. for gcc/fortran three times a warning that
   default:
      gcc_unreachable();
is unreachable as all cases have been covered. If they were covered via 
"case", one could remove the default and let -Wswitch -Werror do the 
work. But in those examples, there are also some additional "if"  
involved, which are before the "switch" - only with those the "default" 
is unreachable.Thus, the "default" has to stay.

The new version of scan.coverity.com allows the project to upload the 
builds themselves - which is the reason that now also Fortran is 
supported. I done a manual build and uploaded it; it could be 
automatized, but that only makes sense if someone regularly looks at the 
results. In any case, if you have already access to scan.coverity.com, 
feel free to log in and look at the results. If not, you can create a 
new account. (I don't know whether I can use the build-upload password 
to create accounts, whether someone else has a project account password 
or whether Coverity has to handle it themselves.)


I have now fixed some of the issues; please have a close look whether 
they make sense. With static analysis as with compiler warnings, one 
sometimes tends to fix them bliendly - causing wrong-code issues that 
way. I also tried to only fix code which is either wrong or bad style; I 
have ignore more bogus errors. Doing so, I have also added some 
gcc_asserts; one could decide that those aren't needed and if a NULL 
derference ever occurs, segfaulting (with the new libbacktrace stack 
trace) gives is sufficient feedback.


Overview about the changes:

* [Memory leak] arith.c's arith_power: We have "result = 
gfc_get_constant_expr (...);", which has to be freed in case of error - 
which we did only in one error case. For some reason, the scanner found 
only the second problem in BT_COMPLEX but not the one in BT_REAL.

* [Out of bounds] array.c's gfc_match_array_ref: I am not sure whether 
that code is unreachable, but in any case it is out of bounds. It does 
not seem to trigger for our test cases; maybe removing it and adding an 
assert is sufficient?

* [Uninitialized memory] array.c's gfc_match_array_constructor: 
gfc_match_decl_type_spec checks whether "ts->kind == -1" thus we to 
initialize it - either directly or as I did with the sledgehammer.


* [dereferenced + later NULL check] array.c's 
gfc_resolve_character_array_constructor: The code has:

   if (expr->ts.u.cl == NULL)
       expr->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);

   if (expr->ts.u.cl->length == NULL)
   else
       gcc_assert (expr->ts.u.cl->length);

As "...->cl->length" is dereferenced, doesn't make sense to check again 
whether "...->cl" is NULL. (Besides, the code flow shows that it shouldn't.)


* [dereferenced + later NULL check] array.c's gfc_array_dimen_size: 
Similar issue, but this time I added a gcc_assert.


* [Same check twice] check.c's numeric_check: Here, one firsts returns 
if the type is numeric, if not, one tries implicit typing. I think the 
second EXPR_VARIABLE should have been EXPR_FUNCTION.

* [dereferenced + later NULL check] class.c's gfc_build_class_symbol. We 
later (for "rank = " check whether "as" exists. I think all calls are of 
the form "&sym->as", but I still added an assert.

* [memory leak] class.c's finalize_component: The "e" is created as 
copy_expr with main component ref added. It is either used in the 
DEALLOCATE or FINAL call, or passed in the loop for subcomponent 
finalization - as those use gfc_copy_expr, it has to be freed in that case.

* [dereferenced + later NULL check] dump-parse-tree.c's show_namespace. 
I think the calls are all pointing to non-NULL namespace, but to be 
careful, I added an assert and removed the check. (Most changes are pure 
re-indenting.)


* [Memory leak]  trans-io.c's transfer_namelist_element: One had code like

   if (ts->type == BT_DERIVED)
        tree expr = build_fold_indirect_ref_loc (input_location,
        for (cmp = ts->u.derived->components; cmp; cmp = cmp->next)
           transfer_namelist_element (block,
                                      full_name,
                                      NULL, cmp, expr);

However, when the derived type has no components, the "expr" is leaking. 
As Fortran 2003 allows empty components, that can actually occur in reality.


* [Memory leak]  trans-io.c's transfer_expr: The same issue.

* [Uninitialized memory] trans-io.c's gfc_trans_transfer: Here, the 
warning is about accessing uninitialized loop elements in 
gfc_cleanup_loop. The reason is that those aren't initialized for 
expr->rank == 0; I thought that the code should be unreachable due to 
the (se.ss != 0) condition, but an assert fails for instance for 
graphite/pr36286.f90. On the other hand, for se.ss != NULL && expr->rank 
== 0, handling lower code part is wrong as it only deals with "loop". 
Probably, one needs to use "if (se.ss == NULL || expr->rank == 0)", 
which I now did.

* [NULL-pointer access?] trans-io.c's gfc_trans_transfer: The issue 
should not occur, but to be safe and to silence the warning. The problem 
the scanner sees is that "ref" can be NULL if there is no ref->type == 
REF_ARRAY.

* [Memory leakage] trans.c's gfc_trans_runtime_check: We forget to call 
va_end.


I think that covers about 1/3 of the gcc/fortran warnings. By the way, 
there are no libgfortran warnings. Most of the remaining issues are 
about memory leakages (or bogus), but for the memory-leak ones require a 
closer look as the analysis jumps through the whole code.


TODO:

There are also real issues like the following in symbol.c's 
gfc_undo_symbols:

               gfc_free_namelist (old->namelist_tail);
               old->namelist_tail->next = NULL;

where one first frees the memory and then sets a component to NULL. 
Locally, I was wondering whether the two lines should be swapped as 
free_namelist also frees ns->next. Alternatively, the "->next" part is 
wrong, which is more in line with the next line of code:
       p->namelist_tail = old->namelist_tail;
But I think one needs to study the code more closely to know what the 
code is supposed to do.

(Unfortunately, there does not seem to be a match for module.c. I know 
that there are memory leaks but the code is written such that one has no 
idea about the flow - especially as a lot is done via "void *" pointers.)


Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
Paul Richard Thomas - Sept. 15, 2012, 3:18 p.m.
Dear Tobias,

> Build and regtested on x86-64-linux.
> OK for the trunk?

OK for trunk - thanks for the patch.

Cheers

Paul
Mikael Morin - Sept. 15, 2012, 3:28 p.m.
Argh! Paul OKed the patch already.
Here are my comments anyway.

On 15/09/2012 11:46, Tobias Burnus wrote:
> Dear all,
> 
> this patch fixes some of the warning showing up for gcc/fortran at
> http://scan.coverity.com/. Coverity sells static C/C++/C#/Java code
> analyzers and offer scanning to open-source projects. The result looks
> like
> http://www.coverity.com/images/products/static-analysis/screenshot-1-large.png
> 
> 


> * [Out of bounds] array.c's gfc_match_array_ref: I am not sure whether
> that code is unreachable, but in any case it is out of bounds. It does
> not seem to trigger for our test cases; maybe removing it and adding an
> assert is sufficient?
>
> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
> index 44ec72e..1611c3b 100644
> --- a/gcc/fortran/array.c
> +++ b/gcc/fortran/array.c
> @@ -253,7 +253,7 @@ coarray:
>  	    gfc_error ("Invalid form of coarray reference at %C");
>  	  return MATCH_ERROR;
>  	}
> -      else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
> +      else if (ar->dimen_type[ar->codimen + ar->dimen - 1] == DIMEN_STAR)
>  	{
>  	  gfc_error ("Unexpected '*' for codimension %d of %d at %C",
>  		     ar->codimen + 1, corank);
That one is not completely obvious.
Your change is bogus in the case ar->dimen==ar->codimen==0 at least.
The loop starts with ar->codimen = 0, and when the closing bracked is
matched, there is an extra ar->codimen++.
So in the scope of the loop, ar->codimen is the maximal coarray index,
not the codimension. I have a feeling that there is no out of bound
here.  Does coverity give more details?



> 
> * [Uninitialized memory] trans-io.c's gfc_trans_transfer: Here, the
> warning is about accessing uninitialized loop elements in
> gfc_cleanup_loop. The reason is that those aren't initialized for
> expr->rank == 0; I thought that the code should be unreachable due to
> the (se.ss != 0) condition, but an assert fails for instance for
> graphite/pr36286.f90. On the other hand, for se.ss != NULL && expr->rank
> == 0, handling lower code part is wrong as it only deals with "loop".
> Probably, one needs to use "if (se.ss == NULL || expr->rank == 0)",
> which I now did.

> diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
> index 34db6fd..4ad961f 100644
> --- a/gcc/fortran/trans-io.c
> +++ b/gcc/fortran/trans-io.c
> @@ -2310,7 +2313,7 @@ gfc_trans_transfer (gfc_code * code)
>    gfc_add_block_to_block (&body, &se.pre);
>    gfc_add_block_to_block (&body, &se.post);
>  
> -  if (se.ss == NULL)
> +  if (se.ss == NULL || expr->rank == 0)
>      tmp = gfc_finish_block (&body);
>    else
>      {
I'm not sure about that one.
I tried adding a `gcc_assert (expr->rank != 0);' in the `else' branch
and it passed for me on pr36286.f90 (but I don't have graphite enabled).



All the other changes look good to me (OK for them).


>
> TODO:
>
> There are also real issues like the following in symbol.c's
> gfc_undo_symbols:
>
>               gfc_free_namelist (old->namelist_tail);
>               old->namelist_tail->next = NULL;
>
> where one first frees the memory and then sets a component to NULL.
> Locally, I was wondering whether the two lines should be swapped as
> free_namelist also frees ns->next. Alternatively, the "->next" part is
> wrong, which is more in line with the next line of code:
>       p->namelist_tail = old->namelist_tail;
> But I think one needs to study the code more closely to know what the
> code is supposed to do.
>
According to the code in match.c, `namelist_tail' seems to be the last
element in the chain so that new elements can be added to
`namelist_tail->next'.
Then `gfc_undo_symbol' should probably have:
               gfc_free_namelist (old->namelist_tail->next);
               old->namelist_tail->next = NULL;


Thanks

Mikael
Tobias Burnus - Sept. 15, 2012, 5:36 p.m.
Hi Mikael,

thanks for your comments.

As a pre-script: Will you look at Paul's revised assignment patch - or 
should I do it?


Mikael Morin wrote:
>> [Out of bounds]
>> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
>> index 44ec72e..1611c3b 100644
>> --- a/gcc/fortran/array.c
>> +++ b/gcc/fortran/array.c
>> @@ -253,7 +253,7 @@ coarray:
>> -      else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
>> +      else if (ar->dimen_type[ar->codimen + ar->dimen - 1] == DIMEN_STAR)
> That one is not completely obvious.

I think that the Coverity warning (and hence the patch) is bogus. 
Actually, all three out-of-bounds warnings in gcc/fortran seem to be 
wrong. I re-checked the code and do now believe that the old version is 
perfectly okay.

If you want to know the Coverity's diagnostic, you can also have access 
to GCC's Coverity scan results. Are you interested?


> --- a/gcc/fortran/trans-io.c
> +++ b/gcc/fortran/trans-io.c
> @@ -2310,7 +2313,7 @@ gfc_trans_transfer (gfc_code * code)
> -  if (se.ss == NULL)
> +  if (se.ss == NULL || expr->rank == 0)
>
> I'm not sure about that one.
> I tried adding a `gcc_assert (expr->rank != 0);' in the `else' branch
> and it passed for me on pr36286.f90 (but I don't have graphite enabled).
>
> All the other changes look good to me (OK for them).

I have committed the two patches without the bogus array.c change and 
without the change above.

I will now rebuild again with
    gcc_assert (expr->rank != 0);
and post all failures.

(A while later.) Hmm, for some reasons, I do not see any failure. I 
wonder why I saw about a dozen failures before.

I am really happy because those two parts of the patch I didn't like.

>> TODO:
>>                gfc_free_namelist (old->namelist_tail);
>>                old->namelist_tail->next = NUL
> According to the code in match.c, `namelist_tail' seems to be the last
> element in the chain so that new elements can be added to
> `namelist_tail->next'.
> Then `gfc_undo_symbol' should probably have:
>                 gfc_free_namelist (old->namelist_tail->next);
>                 old->namelist_tail->next = NULL;

Thanks for the analysis. Will you create a patch?

Tobias

Patch

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_ref): Fix out-of-bounds issue.
	(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 asserts, fix condition.
	* trans.c (gfc_trans_runtime_check): Call va_end

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 6fa7c70..e94566a 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 44ec72e..1611c3b 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -253,7 +253,7 @@  coarray:
 	    gfc_error ("Invalid form of coarray reference at %C");
 	  return MATCH_ERROR;
 	}
-      else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
+      else if (ar->dimen_type[ar->codimen + ar->dimen - 1] == DIMEN_STAR)
 	{
 	  gfc_error ("Unexpected '*' for codimension %d of %d at %C",
 		     ar->codimen + 1, corank);
@@ -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 2235b52..58c5856 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 dca2cfc..2e347cb 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 9d6f93c..a442625 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 34db6fd..4ad961f 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
@@ -2310,7 +2313,7 @@  gfc_trans_transfer (gfc_code * code)
   gfc_add_block_to_block (&body, &se.pre);
   gfc_add_block_to_block (&body, &se.post);
 
-  if (se.ss == NULL)
+  if (se.ss == NULL || expr->rank == 0)
     tmp = gfc_finish_block (&body);
   else
     {
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ff0b243..6365213 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);