gfortran.h (gfc_finalizer): Replaced member `procedure' by two new members `proc_sym' and `proc_tree' to...

2008-08-08  Daniel Kraft  <d@domob.eu>

	* gfortran.h (gfc_finalizer):  Replaced member `procedure' by two
	new members `proc_sym' and `proc_tree' to store the symtree after
	resolution.
	(gfc_find_sym_in_symtree):  Made public.
	* decl.c (gfc_match_final_decl):  Adapted for new member name.
	* interface.c (gfc_find_sym_in_symtree):  Made public.
	(gfc_extend_expr), (gfc_extend_assign):  Changed call accordingly.
	* module.c (mio_finalizer), (mio_f2k_derived), (mio_full_f2k_derived):
	New methods for module-file IO of f2k_derived.
	(mio_symbol):  Do IO of f2k_derived namespace.
	* resolve.c (gfc_resolve_finalizers):  Adapted for new member name and
	finding the symtree for the symbol here.
	* symbol.c (gfc_free_finalizer):  Adapted for new members.

2008-08-08  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/finalize_9.f03:  New test.
	* gfortran.dg/module_md5_1.f90:  Adapted MD5-sum for changed module
	file format.

From-SVN: r138884

10 files changed, 153 insertions, 20 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 38a653a..9b51d99 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2008-08-08  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (gfc_finalizer):  Replaced member `procedure' by two
+	new members `proc_sym' and `proc_tree' to store the symtree after
+	resolution.
+	(gfc_find_sym_in_symtree):  Made public.
+	* decl.c (gfc_match_final_decl):  Adapted for new member name.
+	* interface.c (gfc_find_sym_in_symtree):  Made public.
+	(gfc_extend_expr), (gfc_extend_assign):  Changed call accordingly.
+	* module.c (mio_finalizer), (mio_f2k_derived), (mio_full_f2k_derived):
+	New methods for module-file IO of f2k_derived.
+	(mio_symbol):  Do IO of f2k_derived namespace.
+	* resolve.c (gfc_resolve_finalizers):  Adapted for new member name and
+	finding the symtree for the symbol here.
+	* symbol.c (gfc_free_finalizer):  Adapted for new members.
+
 2008-07-30  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
 
 	* gfc-internals.texi: Update to GFDL 1.2.  Do not list GPL as
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8b9b8c0..2b4bda1 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6682,6 +6682,7 @@ cleanup:
 
 }
 
+
 /* Match a FINAL declaration inside a derived type.  */
 
 match
@@ -6762,7 +6763,7 @@ gfc_match_final_decl (void)
 
       /* Check if we already have this symbol in the list, this is an error.  */
       for (f = gfc_current_block ()->f2k_derived->finalizers; f; f = f->next)
-	if (f->procedure == sym)
+	if (f->proc_sym == sym)
 	  {
 	    gfc_error ("'%s' at %C is already defined as FINAL procedure!",
 		       name);
@@ -6773,7 +6774,8 @@ gfc_match_final_decl (void)
       gcc_assert (gfc_current_block ()->f2k_derived);
       ++sym->refs;
       f = XCNEW (gfc_finalizer);
-      f->procedure = sym;
+      f->proc_sym = sym;
+      f->proc_tree = NULL;
       f->where = gfc_current_locus;
       f->next = gfc_current_block ()->f2k_derived->finalizers;
       gfc_current_block ()->f2k_derived->finalizers = f;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5119248..e315cde 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1958,10 +1958,20 @@ extern iterator_stack *iter_stack;
 typedef struct gfc_finalizer
 {
   struct gfc_finalizer* next;
-  gfc_symbol* procedure;
   locus where; /* Where the FINAL declaration occurred.  */
+
+  /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
+     symtree and later need only that.  This way, we can access and call the
+     finalizers from every context as they should be "always accessible".  I
+     don't make this a union because we need the information whether proc_sym is
+     still referenced or not for dereferencing it on deleting a gfc_finalizer
+     structure.  */
+  gfc_symbol*  proc_sym;
+  gfc_symtree* proc_tree; 
 }
 gfc_finalizer;
+#define gfc_get_finalizer() XCNEW (gfc_finalizer)
+
 
 /************************ Function prototypes *************************/
 
@@ -2399,6 +2409,7 @@ gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
 gfc_try gfc_add_interface (gfc_symbol *);
 gfc_interface *gfc_current_interface_head (void);
 void gfc_set_current_interface_head (gfc_interface *);
+gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
 
 /* io.c */
 extern gfc_st_label format_asterisk;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 84fa660..ba38401 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2513,8 +2513,8 @@ find_symtree0 (gfc_symtree *root, gfc_symbol *sym)
 
 /* Find a symtree for a symbol.  */
 
-static gfc_symtree *
-find_sym_in_symtree (gfc_symbol *sym)
+gfc_symtree *
+gfc_find_sym_in_symtree (gfc_symbol *sym)
 {
   gfc_symtree *st;
   gfc_namespace *ns;
@@ -2652,7 +2652,7 @@ gfc_extend_expr (gfc_expr *e)
 
   /* Change the expression node to a function call.  */
   e->expr_type = EXPR_FUNCTION;
-  e->symtree = find_sym_in_symtree (sym);
+  e->symtree = gfc_find_sym_in_symtree (sym);
   e->value.function.actual = actual;
   e->value.function.esym = NULL;
   e->value.function.isym = NULL;
@@ -2718,7 +2718,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
 
   /* Replace the assignment with the call.  */
   c->op = EXEC_ASSIGN_CALL;
-  c->symtree = find_sym_in_symtree (sym);
+  c->symtree = gfc_find_sym_in_symtree (sym);
   c->expr = NULL;
   c->expr2 = NULL;
   c->ext.actual = actual;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index ed575f9..7da5be1 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3168,6 +3168,78 @@ mio_namespace_ref (gfc_namespace **nsp)
 }
 
 
+/* Save/restore the f2k_derived namespace of a derived-type symbol.  */
+
+static void
+mio_finalizer (gfc_finalizer **f)
+{
+  if (iomode == IO_OUTPUT)
+    {
+      gcc_assert (*f);
+      gcc_assert ((*f)->proc_tree); /* Should already be resolved.  */
+      mio_symtree_ref (&(*f)->proc_tree);
+    }
+  else
+    {
+      *f = gfc_get_finalizer ();
+      (*f)->where = gfc_current_locus; /* Value should not matter.  */
+      (*f)->next = NULL;
+
+      mio_symtree_ref (&(*f)->proc_tree);
+      (*f)->proc_sym = NULL;
+    }
+}
+
+static void
+mio_f2k_derived (gfc_namespace *f2k)
+{
+  /* Handle the list of finalizer procedures.  */
+  mio_lparen ();
+  if (iomode == IO_OUTPUT)
+    {
+      gfc_finalizer *f;
+      for (f = f2k->finalizers; f; f = f->next)
+	mio_finalizer (&f);
+    }
+  else
+    {
+      f2k->finalizers = NULL;
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  gfc_finalizer *cur;
+	  mio_finalizer (&cur);
+	  cur->next = f2k->finalizers;
+	  f2k->finalizers = cur;
+	}
+    }
+  mio_rparen ();
+}
+
+static void
+mio_full_f2k_derived (gfc_symbol *sym)
+{
+  mio_lparen ();
+  
+  if (iomode == IO_OUTPUT)
+    {
+      if (sym->f2k_derived)
+	mio_f2k_derived (sym->f2k_derived);
+    }
+  else
+    {
+      if (peek_atom () != ATOM_RPAREN)
+	{
+	  sym->f2k_derived = gfc_get_namespace (NULL, 0);
+	  mio_f2k_derived (sym->f2k_derived);
+	}
+      else
+	gcc_assert (!sym->f2k_derived);
+    }
+
+  mio_rparen ();
+}
+
+
 /* Unlike most other routines, the address of the symbol node is already
    fixed on input and the name/module has already been filled in.  */
 
@@ -3230,6 +3302,9 @@ mio_symbol (gfc_symbol *sym)
     sym->component_access
       = MIO_NAME (gfc_access) (sym->component_access, access_types);
 
+  /* Load/save the f2k_derived namespace of a derived-type symbol.  */
+  mio_full_f2k_derived (sym);
+
   mio_namelist (sym);
 
   /* Add the fields that say whether this is from an intrinsic module,
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f977de5..c6a241a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7472,22 +7472,29 @@ gfc_resolve_finalizers (gfc_symbol* derived)
       gfc_finalizer* i;
       int my_rank;
 
+      /* Skip this finalizer if we already resolved it.  */
+      if (list->proc_tree)
+	{
+	  prev_link = &(list->next);
+	  continue;
+	}
+
       /* Check this exists and is a SUBROUTINE.  */
-      if (!list->procedure->attr.subroutine)
+      if (!list->proc_sym->attr.subroutine)
 	{
 	  gfc_error ("FINAL procedure '%s' at %L is not a SUBROUTINE",
-		     list->procedure->name, &list->where);
+		     list->proc_sym->name, &list->where);
 	  goto error;
 	}
 
       /* We should have exactly one argument.  */
-      if (!list->procedure->formal || list->procedure->formal->next)
+      if (!list->proc_sym->formal || list->proc_sym->formal->next)
 	{
 	  gfc_error ("FINAL procedure at %L must have exactly one argument",
 		     &list->where);
 	  goto error;
 	}
-      arg = list->procedure->formal->sym;
+      arg = list->proc_sym->formal->sym;
 
       /* This argument must be of our type.  */
       if (arg->ts.type != BT_DERIVED || arg->ts.derived != derived)
@@ -7541,16 +7548,16 @@ gfc_resolve_finalizers (gfc_symbol* derived)
 	{
 	  /* Argument list might be empty; that is an error signalled earlier,
 	     but we nevertheless continued resolving.  */
-	  if (i->procedure->formal)
+	  if (i->proc_sym->formal)
 	    {
-	      gfc_symbol* i_arg = i->procedure->formal->sym;
+	      gfc_symbol* i_arg = i->proc_sym->formal->sym;
 	      const int i_rank = (i_arg->as ? i_arg->as->rank : 0);
 	      if (i_rank == my_rank)
 		{
 		  gfc_error ("FINAL procedure '%s' declared at %L has the same"
 			     " rank (%d) as '%s'",
-			     list->procedure->name, &list->where, my_rank, 
-			     i->procedure->name);
+			     list->proc_sym->name, &list->where, my_rank, 
+			     i->proc_sym->name);
 		  goto error;
 		}
 	    }
@@ -7560,6 +7567,10 @@ gfc_resolve_finalizers (gfc_symbol* derived)
 	if (!arg->as || arg->as->rank == 0)
 	  seen_scalar = true;
 
+	/* Find the symtree for this procedure.  */
+	gcc_assert (!list->proc_tree);
+	list->proc_tree = gfc_find_sym_in_symtree (list->proc_sym);
+
 	prev_link = &list->next;
 	continue;
 
@@ -7581,7 +7592,8 @@ error:
 		 derived->name, &derived->declared_at);
 
   /* TODO:  Remove this error when finalization is finished.  */
-  gfc_error ("Finalization at %L is not yet implemented", &derived->declared_at);
+  gfc_error ("Finalization at %L is not yet implemented",
+	     &derived->declared_at);
 
   return result;
 }
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index d4cbd0b..bf709fa 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2965,9 +2965,12 @@ gfc_free_finalizer (gfc_finalizer* el)
 {
   if (el)
     {
-      --el->procedure->refs;
-      if (!el->procedure->refs)
-	gfc_free_symbol (el->procedure);
+      if (el->proc_sym)
+	{
+	  --el->proc_sym->refs;
+	  if (!el->proc_sym->refs)
+	    gfc_free_symbol (el->proc_sym);
+	}
 
       gfc_free (el);
     }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ba897b0..4ff5fd8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-08-08  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.dg/finalize_9.f03:  New test.
+	* gfortran.dg/module_md5_1.f90:  Adapted MD5-sum for changed module
+	file format.
+
 2008-08-08  Richard Guenther  <rguenther@suse.de>
 
 	* gcc.dg/tree-ssa/ssa-ccp-20.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/finalize_9.f03 b/gcc/testsuite/gfortran.dg/finalize_9.f03
new file mode 100644
index 0000000..464036e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_9.f03
@@ -0,0 +1,8 @@
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! While ALLOCATABLE scalars are not implemented, this even used to ICE.
+! Thanks Tobias Burnus for the test!
+
+integer, allocatable :: x ! { dg-error "may not be ALLOCATABLE" }
+end
diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90
index b9bb5fa..f52426f 100644
--- a/gcc/testsuite/gfortran.dg/module_md5_1.f90
+++ b/gcc/testsuite/gfortran.dg/module_md5_1.f90
@@ -10,5 +10,5 @@ program test
   use foo
   print *, pi
 end program test
-! { dg-final { scan-module "foo" "MD5:2350094d1d87eb25ab22af5f8e96e011" } }
+! { dg-final { scan-module "foo" "MD5:596df8f39d3ddc0b847771cadcb26274" } }
 ! { dg-final { cleanup-modules "foo" } }