Re: [Patch, Fortran] Derived-type finalization, split up: module.c part

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

Daniel,


> I did split off some parts of the finalization patch; see the attached diff.
>  This is the unmodified module.c change, the change to the gfc_finalizer
> data structure and everything that needed to be adapted for this
> structure-change.  Everything else is  left out.

This does indeed make life easier.

> I checked the patch as it is attached and it introduces no regressions on
> x68-32-GNU/Linux.

Good - this is, of course, required:-)

>
> I'd like to get this one checked-in as soon as possible, so I can work on
> typebound-procedure module.c IO building on the f2k_derived IO from this
> patch.    What do you think about it and the few XXX comments in this part?

Agreed - see comments below.

> Is it ok to check this change in without direct tests for it in the
> test-suite?  But those will follow in the full finalizer patch and in fact
> this code is tested by those tests.

OK subject to dealing with comments below.

Thanks for this patch and the huge amount of work that you are doing.
If you can feed more fragments like this to me this would be kinder on
my head!

Paul

>
> Thanks,
> Daniel
>
> --
> Done:     Arc-Bar-Sam-Val-Wiz, Dwa-Elf-Gno-Hum-Orc, Law-Neu-Cha, Fem-Mal
> Underway: Cav-Dwa-Law-Fem
> To go:    Cav-Hea-Kni-Mon-Pri-Ran-Rog-Tou
>
> Index: gcc/fortran/interface.c
> ===================================================================
> --- gcc/fortran/interface.c     (revision 138574)
> +++ gcc/fortran/interface.c     (working copy)
> @@ -2513,8 +2513,8 @@ find_symtree0 (gfc_symtree *root, gfc_sy
>
>  /* 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_name
>
>   /* 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: gcc/fortran/symbol.c
> ===================================================================
> --- gcc/fortran/symbol.c        (revision 138574)
> +++ gcc/fortran/symbol.c        (working copy)
> @@ -2965,9 +2965,13 @@ 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);
> +       }
> +      /* XXX: Do we need to do something (deref) for the tree?  */

No, we need nothing else.  The final cleanup checks that refs has gone
to zero before freeing the symbol.  Remove the comment.

Hmmm!  That said, we are cleaning up and freeing the f2k_derived
namespace  and the gfc_finalizers at the end of compilation, I trust?

>
>       gfc_free (el);
>     }
> Index: gcc/fortran/decl.c
> ===================================================================
> --- gcc/fortran/decl.c  (revision 138574)
> +++ gcc/fortran/decl.c  (working copy)
> @@ -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: gcc/fortran/gfortran.h
> ===================================================================
> --- gcc/fortran/gfortran.h      (revision 138574)
> +++ gcc/fortran/gfortran.h      (working copy)
> @@ -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 *, g
>  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: gcc/fortran/module.c
> ===================================================================
> --- gcc/fortran/module.c        (revision 138574)
> +++ gcc/fortran/module.c        (working copy)
> @@ -3168,6 +3168,79 @@ mio_namespace_ref (gfc_namespace **nsp)
>  }
>
>
> +/* Save/restore the f2k_derived namespace of a derived-type symbol.  */
> +/* XXX: Check if this format is ok like I did it.  */

Obviously, this one can go.

> +
> +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 +3303,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: gcc/fortran/resolve.c
> ===================================================================
> --- gcc/fortran/resolve.c       (revision 138574)
> +++ gcc/fortran/resolve.c       (working copy)
> @@ -7472,22 +7472,32 @@ gfc_resolve_finalizers (gfc_symbol* deri
>       gfc_finalizer* i;
>       int my_rank;
>
> +      /* Skip this finalizer if we already resolved it.  */
> +      /* XXX: Probably we could skip the entire loop as all would already
> be
> +        resolved, speeding things up.  But if this difference would not
> matter,
> +        I believe it's better and cleaner to keep the loop.  */

If that's what you think, delete the comment.

> +      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 +7551,16 @@ gfc_resolve_finalizers (gfc_symbol* deri
>        {
>          /* 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 +7570,10 @@ gfc_resolve_finalizers (gfc_symbol* deri
>        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 +7595,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: gcc/testsuite/gfortran.dg/finalize_9.f03
> ===================================================================
> --- gcc/testsuite/gfortran.dg/finalize_9.f03    (revision 0)
> +++ gcc/testsuite/gfortran.dg/finalize_9.f03    (revision 0)
> @@ -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: gcc/testsuite/gfortran.dg/module_md5_1.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/module_md5_1.f90  (revision 138574)
> +++ gcc/testsuite/gfortran.dg/module_md5_1.f90  (working copy)
> @@ -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" } }
>
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
 --Hitchhikers Guide to the Galaxy