This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Commit] Fortran-experiments branch
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Mon, 18 Jun 2007 16:50:28 -0700
- Subject: [Commit] Fortran-experiments branch
I've committed the attached after a buld and successful
regression test of x86_64-*-freebsd.
2007-06-18 Christopher D. Rickett <crickett@lanl.gov>
* symbol.c (gen_fptr_param, gen_shape_param, build_formal_args):
Set names for CPTR, FPTR, and SHAPE parameters to
c_f_pointer/c_f_procpointer.
--
Steve
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 125723)
+++ gcc/fortran/symbol.c (working copy)
@@ -3316,13 +3316,16 @@ static void
gen_fptr_param (gfc_formal_arglist **head,
gfc_formal_arglist **tail,
const char *module_name,
- gfc_namespace *ns)
+ gfc_namespace *ns, const char *f_ptr_name)
{
gfc_symbol *param_sym = NULL;
gfc_symtree *param_symtree = NULL;
gfc_formal_arglist *formal_arg = NULL;
const char *f_ptr_out = "gfc_fptr__";
+ if (f_ptr_name != NULL)
+ f_ptr_out = f_ptr_name;
+
gfc_get_sym_tree (f_ptr_out, ns, ¶m_symtree);
if (param_symtree != NULL)
param_sym = param_symtree->n.sym;
@@ -3356,7 +3359,7 @@ static void
gen_shape_param (gfc_formal_arglist **head,
gfc_formal_arglist **tail,
const char *module_name,
- gfc_namespace *ns)
+ gfc_namespace *ns, const char *shape_param_name)
{
gfc_symbol *param_sym = NULL;
gfc_symtree *param_symtree = NULL;
@@ -3364,6 +3367,9 @@ gen_shape_param (gfc_formal_arglist **he
const char *shape_param = "gfc_shape_array__";
int i;
+ if (shape_param_name != NULL)
+ shape_param = shape_param_name;
+
gfc_get_sym_tree (shape_param, ns, ¶m_symtree);
if (param_symtree != NULL)
param_sym = param_symtree->n.sym;
@@ -3449,16 +3455,16 @@ build_formal_args (gfc_symbol *new_proc_
(old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
{
gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
- gfc_current_ns, NULL);
+ gfc_current_ns, "cptr");
gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
- gfc_current_ns);
+ gfc_current_ns, "fptr");
/* If we're dealing with c_f_pointer, it has an optional third arg. */
if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER)
{
gen_shape_param (&head, &tail,
(const char *) new_proc_sym->module,
- gfc_current_ns);
+ gfc_current_ns, "shape");
}
}
else if (old_sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)