SoC fortran procedure pointers

[Janus Weil]

Hello Paul,
it seems to me that your patch does not handle the formal argument
list of a declared procedure in the right way. Let's have another look
at the following piece of code from decl.c(gfc_match_procedure), which
Tobias had been referring to before:

> +       if (s != NULL && !(s->attr.procedure && s->formal == NULL))
> +         {
> +           sym->formal = gfc_get_formal_arglist ();
> +           if (s->attr.procedure)
> +             sym->formal->sym = s->formal->sym;
> +           else
> +             sym->formal->sym = s;
> +         }
> +
> +       if (s != NULL && s->attr.procedure && s->formal == NULL)
> +         sym->ts = s->ts;

Here "sym" is the newly defined procedure, while "s" is the symbol
which the procedure inherits its interface from (a procedure or
abstract interface). Now in principle the formal argument list of s
should be copied to sym. But what in fact happens is that only the
first argument is copied (sym->formal->sym), while all the rest
(sym->formal->next...) is ignored. Is that right, or am I getting
something wrong here?

Moreover, I don't quite see why the last line ( sym->ts = s->ts ) is
only executed if s->formal==NULL. Shouldn't the typespec be inherited
in any case, regardless of whether the formal argument list is empty
or not?

In case I'm right about the formal argument list: I also had a look at
Christopher Rickett's work on procedure pointers, and found there a
routine named "copy_formal_args", which could be just what we need to
correctly treat formal args:

/* Copy the formal args from an existing symbol, src, into a new
   symbol, dest.  New formal args are created, and the description of
   each arg is set according to the existing ones.  This function is
   used when creating procedure declaration variables from a procedure
   declaration statement (see match_proc_decl()) to create the formal
   args based on the args of a given named interface.  */

void copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
{
  gfc_formal_arglist *head = NULL;
  gfc_formal_arglist *tail = NULL;
  gfc_formal_arglist *formal_arg = NULL;
  gfc_formal_arglist *curr_arg = NULL;
  gfc_formal_arglist *formal_prev = NULL;
  gfc_namespace *parent_ns = NULL;

  /* Save current namespace so we can change it for formal args.  */
  parent_ns = gfc_current_ns;

  /* Create a new namespace, which will be the formal ns (namespace
     of the formal args).  */
  gfc_current_ns = gfc_get_namespace (parent_ns, 0);
  gfc_current_ns->proc_name = dest;

  curr_arg = src->formal;
  formal_prev = NULL;
  while (curr_arg != NULL)
    {
      /* Allocate a new struct for the formal arg.  */
      formal_arg = gfc_get_formal_arglist ();

      /* Create symbol for the arg.  */
      gfc_get_symbol (curr_arg->sym->name, gfc_current_ns, &(formal_arg->sym));

      /* May need to copy more info for the symbol.  */
      formal_arg->sym->attr = curr_arg->sym->attr;
      formal_arg->sym->ts = curr_arg->sym->ts;

      /* If this isn't the first arg, set up the next ptr.  For the
	 last arg built, the formal_arg->next will never get set to
	 anything other than NULL.  */
      formal_arg->next = NULL;
      if (formal_prev != NULL)
	formal_prev->next = formal_arg;
      formal_prev = formal_arg;

      /* Add arg to list of formal args.  */
      add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);

      /* Will reuse for any additional arg(s).  */
      formal_arg = NULL;

      /* Go to the next arg, if any.  */
      curr_arg = curr_arg->next;
    }

  /* Add the interface to the symbol.  */
  add_proc_interface (dest, IFSRC_DECL, head);

  /* Store the formal namespace information.  */
  if (dest->formal != NULL)
    /* The current ns should be that for the dest proc.  */
    dest->formal_ns = gfc_current_ns;

  /* Restore the current namespace to what it was on entry.  */
  gfc_current_ns = parent_ns;
}