OSDN Git Service

2008-08-08 Daniel Kraft <d@domob.eu>
authordomob <domob@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 8 Aug 2008 18:19:46 +0000 (18:19 +0000)
committerdomob <domob@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 8 Aug 2008 18:19:46 +0000 (18:19 +0000)
* 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.

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

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/gfortran.h
gcc/fortran/interface.c
gcc/fortran/module.c
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/finalize_9.f03 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/module_md5_1.f90

index 38a653a..9b51d99 100644 (file)
@@ -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
index 8b9b8c0..2b4bda1 100644 (file)
@@ -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;
index 5119248..e315cde 100644 (file)
@@ -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;
index 84fa660..ba38401 100644 (file)
@@ -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;
index ed575f9..7da5be1 100644 (file)
@@ -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,
index f977de5..c6a241a 100644 (file)
@@ -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;
 }
index d4cbd0b..bf709fa 100644 (file)
@@ -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);
     }
index ba897b0..4ff5fd8 100644 (file)
@@ -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 (file)
index 0000000..464036e
--- /dev/null
@@ -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
index b9bb5fa..f52426f 100644 (file)
@@ -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" } }