diff mbox

[Fortran] Plug memory leaks; fix tree-check ICE for PR

Message ID 503A6726.9020404@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Aug. 26, 2012, 6:12 p.m. UTC 
This patch fixes one ICE and several memory leaks. But there are more.

*********************

The patch with symbol.c and resolve.c fixes the following issue: 
gfortran leaks memory for:

       REAL FUNCTION GGL(ds)
       GGL = 16806.D0
       END

The problem is the following code in resolve_symbol:

   /* Make sure the formal namespace is present.  */
   if (sym->formal && !sym->formal_ns)
...
       if (formal)
         {
           sym->formal_ns = formal->sym->ns;
           sym->formal_ns->refs++;
         }

Thus, there are now two references to the same namespace. At the end, 
the memory is freed via
gfc_symbol_done_2, which calls gfc_free_namespace (gfc_current_ns). In 
the latter, one has:

   ns->refs--;
   if (ns->refs > 0)
     return;
   free_sym_tree (ns->sym_root);

and the latter frees the formal namespace. The problem is that "ns->ref 
== 2" won't get decreased. That's fixed by the first patch.

  * * *

A similar issue existed for the CONTAINS leakage, which was mentioned 
the other day. Here, the problem is the increment in get_proc_name. 
However, a simple patch with the sym->refs++ in decl.c and symbol.c's 
special case for ENTRY wasn't sufficient as 
gfortran.dg/proc_ptr_result_1.f90 failed. I have now added some extra 
code to parse. to handle "ppr@".

(If one uses valgrind on gfortran.dg/proc_ptr_result_1.f90 it leaks some 
gfc_symbol memory; however, the problems seem to be unrelated.)

* * *

gfortran didn't free gfc_common_head; I added a refs and free it now. 
(For blank commons, no special code is needed as ns->common_head is not 
a pointer.)

* * *

TODO: Despite my hopes for previous patch, there is at least one gfc_ss 
leak left (for channel.f90):

==12987==    by 0xE6A7A8: xcalloc (xmalloc.c:162)
==12987==    by 0x6074A3: gfc_get_array_ss(gfc_ss*, gfc_expr*, int, 
gfc_ss_type) (trans-array.c:561)
==12987==    by 0x613870: gfc_walk_expr(gfc_expr*) (trans-array.c:8787)
==12987==    by 0x63A908: gfc_trans_arrayfunc_assign(gfc_expr*, 
gfc_expr*) (trans-expr.c:6749)
==12987==    by 0x63C281: gfc_trans_assignment(gfc_expr*, gfc_expr*, 
bool, bool) (trans-expr.c:7438)
==12987==    by 0x602C31: trans_code(gfc_code*, tree_node*) (trans.c:1312)
==12987==    by 0x65ED66: gfc_trans_do(gfc_code*, tree_node*) 
(trans-stmt.c:1395)


TODO: There are some more failures, e.g. fatigue.f90 shows invalid reads
==13021==    at 0x57C718: _ZL10show_locusP5locusii.isra.3 (error.c:392)
==13021==    by 0x57CD55: error_print(char const*, char const*, 
__va_list_tag*) (error.c:661)
==13021==    by 0x57D878: gfc_error(char const*, ...) (error.c:956)
==13021==    by 0x5C3C16: match_complex_part(gfc_expr**) (primary.c:1205)
==13021==    by 0x5C3DE6: gfc_match_literal_constant(gfc_expr**, int) 
(primary.c:1296)
and memory leakage in
==13021==    by 0xE6A7A8: xcalloc (xmalloc.c:162)
==13021==    by 0x5F0077: gfc_new_symbol(char const*, gfc_namespace*) 
(symbol.c:2569)
==13021==    by 0x5B5A75: read_module() (module.c:4698)
==13021==    by 0x5B5E5B: gfc_use_module(gfc_use_list*) (module.c:6147)
==13021==    by 0x5B7233: gfc_use_modules() (module.c:6270)
==13021==    by 0x5BC147: use_modules() (parse.c:88)


  * * * * * * * * * * * * * * *

The trans-stmt.c patch fixes a tree-check ICE as we mix different 
logical types; I decided to use the previous type instead folding to the 
boolean_type_node.

Do you think it makes sense to backport it to 4.6/4.7?

  * * *

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

Tobias

PS: I wonder why gfortran.dg/interface_3.f90 passed before, given that 
"proc_locus" wasn't set before. I also wonder why my patch causes the 
test case to segfault. Well, at least that bug is now also fixed.

Comments

Tobias Burnus Aug. 26, 2012, 6:24 p.m. UTC | #1 
Tobias Burnus wrote:
>
> PS: I wonder why gfortran.dg/interface_3.f90 passed before, given that 
> "proc_locus" wasn't set before. I also wonder why my patch causes the 
> test case to segfault. Well, at least that bug is now also fixed.

Answer: Because I am too strupid to read the patch after spending way 
too much time on this patch. I had accidentally deleted a line:

> @@ -2452,7 +2451,9 @@ loop:
>     accept_statement (st);
>     prog_unit = gfc_new_block;
>     prog_unit->formal_ns = gfc_current_ns;
> -  proc_locus = gfc_current_locus;
> +  if (prog_unit == prog_unit->formal_ns->proc_name
> +      && prog_unit->ns != prog_unit->formal_ns)
> +    prog_unit->refs++;

On the other hand, I think the result of the current patch

     subroutine thy_sub (a) ! { dg-error "enclosing procedure" }
                       1
Error: INTERFACE procedure 'thy_sub' at (1) has the same name as the 
enclosing procedure

is better than the previous result

     subroutine thy_sub (a) ! { dg-error "enclosing procedure" }
                                                                1
Error: INTERFACE procedure 'thy_sub' at (1) has the same name as the 
enclosing procedure


Thus, puzzle solved and diagnostics improved.

Tobias
diff mbox

Patch

2012-08-26  Tobias Burnus  <burnus@net-b.de>

	PR fortran/41093
	* gfortran.h (gfc_common_head): Add "int refs".
	* match.c (gfc_match_common): Increment refs.
	* resolve.c (resolve_symbol): Only increment formal_ns->refs
	if formal_ns is not sym->ns.
	* symbol.c (gfc_free_symbol): Only free formal_ns if
	if formal_ns is not sym->ns. Free common_block if refs is one.
	(gfc_release_symbol): Release formal_ns only if the
	symbol is not ENTRY of a module.
	* decl.c (get_proc_name): Don't increment gfc_current_ns->refs.
	* parse.c (parse_interface): Incement proc_unit->refs++ for
	proc-pointer result variables.

	PR fortran/54370
	* trans-stmt.c (gfc_trans_do_while): Don't change the logical
	kind for negation of the condition.

2012-08-26  Tobias Burnus  <burnus@net-b.de>

	PR fortran/54370
	* gfortran.dg/do_5.f90: New.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 87eb8a0..efd21dc 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -891,7 +891,6 @@  get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
     return rc;
 
   sym = *result;
-  gfc_current_ns->refs++;
 
   if (sym && !sym->gfc_new && gfc_current_state () != COMP_INTERFACE)
     {
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4c8a856..d67d57b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1266,6 +1266,7 @@  typedef struct gfc_common_head
   struct gfc_symbol *head;
   const char* binding_label;
   int is_bind_c;
+  int refs;
 }
 gfc_common_head;
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 0b1cf5a..4c713a5 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4398,6 +4398,7 @@  gfc_match_common (void)
 
           /* Store a ref to the common block for error checking.  */
           sym->common_block = t;
+          sym->common_block->refs++;
           
           /* See if we know the current common block is bind(c), and if
              so, then see if we can check if the symbol is (which it'll
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index a4ff199..d13d816 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3809,7 +3809,8 @@  mio_symbol (gfc_symbol *sym)
       if (sym->formal_ns)
 	{
 	  sym->formal_ns->proc_name = sym;
-	  sym->refs++;
+	  if (sym->formal_ns != sym->ns)
+	    sym->refs++;
 	}
     }
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index c0ec6e4..5c5d381 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2363,7 +2363,6 @@  parse_interface (void)
   gfc_interface_info save;
   gfc_state_data s1, s2;
   gfc_statement st;
-  locus proc_locus;
 
   accept_statement (ST_INTERFACE);
 
@@ -2452,7 +2451,9 @@  loop:
   accept_statement (st);
   prog_unit = gfc_new_block;
   prog_unit->formal_ns = gfc_current_ns;
-  proc_locus = gfc_current_locus;
+  if (prog_unit == prog_unit->formal_ns->proc_name
+      && prog_unit->ns != prog_unit->formal_ns)
+    prog_unit->refs++;
 
 decl:
   /* Read data declaration statements.  */
@@ -2493,7 +2494,8 @@  decl:
 	&& strcmp (current_interface.ns->proc_name->name,
 		   prog_unit->name) == 0)
     gfc_error ("INTERFACE procedure '%s' at %L has the same name as the "
-	       "enclosing procedure", prog_unit->name, &proc_locus);
+	       "enclosing procedure", prog_unit->name,
+	       &current_interface.ns->proc_name->declared_at);
 
   goto loop;
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c9be70e..63b730c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13086,7 +13086,8 @@  resolve_symbol (gfc_symbol *sym)
       if (formal)
 	{
 	  sym->formal_ns = formal->sym->ns;
-	  sym->formal_ns->refs++;
+          if (sym->ns != formal->sym->ns)
+	    sym->formal_ns->refs++;
 	}
     }
 
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 5a1e5ad..4d030b7 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2511,7 +2511,8 @@  gfc_free_symbol (gfc_symbol *sym)
 
   gfc_free_namelist (sym->namelist);
 
-  gfc_free_namespace (sym->formal_ns);
+  if (sym->ns != sym->formal_ns)
+    gfc_free_namespace (sym->formal_ns);
 
   if (!sym->attr.generic_copy)
     gfc_free_interface (sym->generic);
@@ -2520,6 +2521,13 @@  gfc_free_symbol (gfc_symbol *sym)
 
   gfc_free_namespace (sym->f2k_derived);
 
+  if (sym->common_block && sym->common_block->name[0] != '\0')
+    { 
+      sym->common_block->refs--; 
+      if (sym->common_block->refs == 0)
+	free (sym->common_block);
+    }
+
   free (sym);
 }
 
@@ -2532,7 +2540,8 @@  gfc_release_symbol (gfc_symbol *sym)
   if (sym == NULL)
     return;
 
-  if (sym->formal_ns != NULL && sym->refs == 2)
+  if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
+      && (!sym->attr.entry || !sym->module))
     {
       /* As formal_ns contains a reference to sym, delete formal_ns just
 	 before the deletion of sym.  */
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 9467601..8bc4916 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1785,7 +1785,7 @@  gfc_trans_do_while (gfc_code * code)
   gfc_conv_expr_val (&cond, code->expr1);
   gfc_add_block_to_block (&block, &cond.pre);
   cond.expr = fold_build1_loc (code->expr1->where.lb->location,
-			       TRUTH_NOT_EXPR, boolean_type_node, cond.expr);
+			       TRUTH_NOT_EXPR, TREE_TYPE (cond.expr), cond.expr);
 
   /* Build "IF (! cond) GOTO exit_label".  */
   tmp = build1_v (GOTO_EXPR, exit_label);
--- /dev/null	2012-08-26 08:23:10.319776146 +0200
+++ gcc/gcc/testsuite/gfortran.dg/do_5.f90	2012-08-26 16:34:15.000000000 +0200
@@ -0,0 +1,29 @@ 
+! { dg-do compile }
+!
+! PR fortran/54370
+!
+! The following program was ICEing at tree-check time
+! "L()" was regarded as default-kind logical.
+!
+! Contributed by Kirill Chilikin
+!
+      MODULE M
+      CONTAINS
+
+      LOGICAL(C_BOOL) FUNCTION L() BIND(C)
+      USE, INTRINSIC :: ISO_C_BINDING
+      L = .FALSE.
+      END FUNCTION
+
+      LOGICAL(8) FUNCTION L2() BIND(C)
+      L2 = .FALSE._8
+      END FUNCTION
+
+      SUBROUTINE S()
+      DO WHILE (L())
+      ENDDO
+      DO WHILE (L2())
+      ENDDO
+      END
+
+      END