@@ -3817,6 +3817,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
gfc_symtree *tmp_symtree;
gfc_symbol *tmp_sym;
gfc_constructor *c;
+ iso_c_binding_symbol type_id;
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
@@ -3838,25 +3839,19 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
/* The c_ptr and c_funptr derived types will provide the
definition for c_null_ptr and c_null_funptr, respectively. */
if (ptr_id == ISOCBINDING_NULL_PTR)
- tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
+ type_id = ISOCBINDING_PTR;
else
- tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+ type_id = ISOCBINDING_FUNPTR;
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (type_id);
if (tmp_sym->ts.u.derived == NULL)
{
/* This can occur if the user forgot to declare c_ptr or
- c_funptr and they're trying to use one of the procedures
- that has arg(s) of the missing type. In this case, a
- regular version of the thing should have been put in the
- current ns. */
-
- generate_isocbinding_symbol (module_name, ptr_id == ISOCBINDING_NULL_PTR
- ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR,
- (const char *) (ptr_id == ISOCBINDING_NULL_PTR
- ? "c_ptr"
- : "c_funptr"));
- tmp_sym->ts.u.derived =
- get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
- ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
+ c_funptr and they're trying to use one of the procedures
+ that has arg(s) of the missing type. In this case, a
+ regular version of the thing should have been put in the
+ current ns. */
+ generate_isocbinding_symbol (module_name, type_id, NULL);
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (type_id);
}
/* Module name is some mangled version of iso_c_binding. */
@@ -3929,6 +3924,7 @@ gen_cptr_param (gfc_formal_arglist **head,
gfc_formal_arglist *formal_arg = NULL;
const char *c_ptr_in;
const char *c_ptr_type = NULL;
+ iso_c_binding_symbol c_ptr_id;
if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
c_ptr_type = "c_funptr";
@@ -3957,23 +3953,18 @@ gen_cptr_param (gfc_formal_arglist **head,
param_sym->attr.value = 1;
param_sym->attr.use_assoc = 1;
- /* Get the symbol for c_ptr or c_funptr, no matter what it's name is
+ /* Get the symbol for c_ptr or c_funptr, no matter what it's name is
(user renamed). */
if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
- c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+ c_ptr_id = ISOCBINDING_FUNPTR;
else
- c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR);
+ c_ptr_id = ISOCBINDING_PTR;
+ c_ptr_sym = get_iso_c_binding_dt (c_ptr_id);
if (c_ptr_sym == NULL)
{
/* This can happen if the user did not define c_ptr but they are
- trying to use one of the iso_c_binding functions that need it. */
- if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
- generate_isocbinding_symbol (module_name, ISOCBINDING_FUNPTR,
- (const char *)c_ptr_type);
- else
- generate_isocbinding_symbol (module_name, ISOCBINDING_PTR,
- (const char *)c_ptr_type);
-
+ trying to use one of the iso_c_binding functions that need it. */
+ generate_isocbinding_symbol (module_name, c_ptr_id, NULL);
gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
}
@@ -4556,31 +4547,25 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
}
else
{
- /* Here, we're taking the simple approach. We're defining
- c_loc as an external identifier so the compiler will put
- what we expect on the stack for the address we want the
- C address of. */
+ iso_c_binding_symbol c_ptr_id;
+
+ /* Here, we're taking the simple approach. We're defining
+ c_loc as an external identifier so the compiler will put
+ what we expect on the stack for the address we want the
+ C address of. */
tmp_sym->ts.type = BT_DERIVED;
- if (s == ISOCBINDING_LOC)
- tmp_sym->ts.u.derived =
- get_iso_c_binding_dt (ISOCBINDING_PTR);
- else
- tmp_sym->ts.u.derived =
- get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+ if (s == ISOCBINDING_LOC)
+ c_ptr_id = ISOCBINDING_PTR;
+ else
+ c_ptr_id = ISOCBINDING_FUNPTR;
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (c_ptr_id);
if (tmp_sym->ts.u.derived == NULL)
{
- /* Create the necessary derived type so we can continue
- processing the file. */
- generate_isocbinding_symbol
- (mod_name, s == ISOCBINDING_FUNLOC
- ? ISOCBINDING_FUNPTR : ISOCBINDING_PTR,
- (const char *)(s == ISOCBINDING_FUNLOC
- ? "c_funptr" : "c_ptr"));
- tmp_sym->ts.u.derived =
- get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
- ? ISOCBINDING_FUNPTR
- : ISOCBINDING_PTR);
+ /* Create the necessary derived type so we can continue
+ processing the file. */
+ generate_isocbinding_symbol (mod_name, c_ptr_id, NULL);
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (c_ptr_id);
}
/* The function result is itself (no result clause). */