diff options
Diffstat (limited to 'gcc/fortran/symbol.c')
| -rw-r--r-- | gcc/fortran/symbol.c | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 7414616..6ffd869 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3839,6 +3839,59 @@ copy_formal_args (gfc_symbol *dest, gfc_symbol *src) gfc_current_ns = parent_ns; } +void +copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src) +{ + gfc_formal_arglist *head = NULL; + gfc_formal_arglist *tail = NULL; + gfc_formal_arglist *formal_arg = NULL; + gfc_intrinsic_arg *curr_arg = NULL; + gfc_formal_arglist *formal_prev = NULL; + /* Save current namespace so we can change it for formal args. */ + gfc_namespace *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; + + for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next) + { + formal_arg = gfc_get_formal_arglist (); + gfc_get_symbol (curr_arg->name, gfc_current_ns, &(formal_arg->sym)); + + /* May need to copy more info for the symbol. */ + formal_arg->sym->ts = curr_arg->ts; + formal_arg->sym->attr.optional = curr_arg->optional; + /*formal_arg->sym->attr = curr_arg->sym->attr; + formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as); + copy_formal_args (formal_arg->sym, curr_arg->sym);*/ + + /* 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. */ + if (formal_prev != NULL) + formal_prev->next = formal_arg; + else + formal_arg->next = NULL; + + formal_prev = formal_arg; + + /* Add arg to list of formal args. */ + add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); + } + + /* 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; +} + /* Builds the parameter list for the iso_c_binding procedure c_f_pointer or c_f_procpointer. The old_sym typically refers to a generic version of either the c_f_pointer or c_f_procpointer |