@@ -2626,7 +2626,8 @@ gfc_try gfc_verify_c_interop_param (gfc_symbol *);
gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
gfc_try verify_bind_c_derived_type (gfc_symbol *);
gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
-void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
+void generate_isocbinding_symbol (const char *, iso_c_binding_symbol,
+ const char *, bool);
gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, const char *, int);
int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
int gfc_get_ha_symbol (const char *, gfc_symbol **);
@@ -5708,7 +5708,8 @@ import_iso_c_binding_module (void)
generate_isocbinding_symbol (iso_c_module_name,
(iso_c_binding_symbol) i,
u->local_name[0] ? u->local_name
- : u->use_name);
+ : u->use_name,
+ false);
}
}
@@ -5763,7 +5764,8 @@ import_iso_c_binding_module (void)
default:
generate_isocbinding_symbol (iso_c_module_name,
- (iso_c_binding_symbol) i, NULL);
+ (iso_c_binding_symbol) i, NULL,
+ false);
}
}
}
@@ -3837,7 +3837,7 @@ gen_special_c_interop_ptr (int ptr_id, gfc_symbol *tmp_sym,
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);
+ generate_isocbinding_symbol (module_name, type_id, NULL, true);
tmp_sym->ts.u.derived = get_iso_c_binding_dt (type_id);
}
@@ -3945,7 +3945,7 @@ gen_cptr_param (gfc_formal_arglist **head,
{
/* 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. */
- generate_isocbinding_symbol (module_name, c_ptr_id, NULL);
+ generate_isocbinding_symbol (module_name, c_ptr_id, NULL, true);
c_ptr_sym = get_iso_c_binding_dt (c_ptr_id);
}
@@ -4248,6 +4248,39 @@ std_for_isocbinding_symbol (int id)
}
}
+
+/* Tells whether symbol TMP_SYM is ISO_C_BINDING's symbol identified by SYM_ID.
+ If TMP_SYM is a generic, it uses the derived type in the list of interfaces
+ (if there is one). Returns the symbol if it matches SYM_ID,
+ NULL otherwise. */
+
+static gfc_symbol *
+check_iso_c_symbol (gfc_symbol *tmp_sym, iso_c_binding_symbol sym_id)
+{
+ if (tmp_sym->attr.generic)
+ tmp_sym = gfc_find_dt_in_generic (tmp_sym);
+
+ if (tmp_sym == NULL || tmp_sym->from_intmod != INTMOD_ISO_C_BINDING)
+ return NULL;
+
+ /* FIXME: This block is probably unnecessary. */
+ if (tmp_sym->attr.flavor == FL_DERIVED
+ && get_iso_c_binding_dt (tmp_sym->intmod_sym_id) == NULL)
+ {
+ gfc_dt_list *dt_list;
+ dt_list = gfc_get_dt_list ();
+ dt_list->derived = tmp_sym;
+ dt_list->next = gfc_derived_types;
+ gfc_derived_types = dt_list;
+ }
+
+ if (tmp_sym->intmod_sym_id != sym_id)
+ return NULL;
+
+ return tmp_sym;
+}
+
+
/* Generate the given set of C interoperable kind objects, or all
interoperable kinds. This function will only be given kind objects
for valid iso_c_binding defined types because this is verified when
@@ -4261,7 +4294,7 @@ std_for_isocbinding_symbol (int id)
void
generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
- const char *local_name)
+ const char *local_name, bool hidden)
{
const char *const name = (local_name && local_name[0]) ? local_name
: c_interop_kinds_table[s].name;
@@ -4272,34 +4305,47 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
if (gfc_notification_std (std_for_isocbinding_symbol (s)) == ERROR)
return;
- tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+ if (!hidden)
+ {
+ tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
+ /* Already exists in this scope so don't re-add it. */
+ if (tmp_symtree != NULL)
+ {
+ if (check_iso_c_symbol (tmp_symtree->n.sym, s) == NULL)
+ tmp_symtree->ambiguous = 1;
+
+ return;
+ }
+ }
- /* Already exists in this scope so don't re-add it. */
- if (tmp_symtree != NULL && (tmp_sym = tmp_symtree->n.sym) != NULL
- && (!tmp_sym->attr.generic
- || (tmp_sym = gfc_find_dt_in_generic (tmp_sym)) != NULL)
- && tmp_sym->from_intmod == INTMOD_ISO_C_BINDING)
+ tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+ c_interop_kinds_table[s].name);
+ if (tmp_symtree != NULL)
{
- if (tmp_sym->attr.flavor == FL_DERIVED
- && !get_iso_c_binding_dt (tmp_sym->intmod_sym_id))
+ tmp_sym = check_iso_c_symbol (tmp_symtree->n.sym, s);
+ if (tmp_sym != NULL)
{
- gfc_dt_list *dt_list;
- dt_list = gfc_get_dt_list ();
- dt_list->derived = tmp_sym;
- dt_list->next = gfc_derived_types;
- gfc_derived_types = dt_list;
- }
+ if (hidden)
+ return;
- return;
+ gcc_assert (strcmp (name, c_interop_kinds_table[s].name) != 0);
+ tmp_symtree = gfc_new_symtree (&gfc_current_ns->sym_root, name);
+ tmp_symtree->n.sym = tmp_sym;
+ tmp_symtree->n.sym->refs++;
+ return;
+ }
}
/* Create the sym tree in the current ns. */
- gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
- if (tmp_symtree)
- tmp_sym = tmp_symtree->n.sym;
+ if (!hidden)
+ tmp_symtree = gfc_new_symtree (&gfc_current_ns->sym_root, name);
else
- gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
- "create symbol");
+ tmp_symtree = gfc_get_unique_symtree (gfc_current_ns);
+
+ tmp_sym = gfc_new_symbol (c_interop_kinds_table[s].name, gfc_current_ns);
+ tmp_symtree->n.sym = tmp_sym;
+ tmp_sym->refs++;
/* Say what module this symbol belongs to. */
tmp_sym->module = gfc_get_string (mod_name);
@@ -4392,21 +4438,26 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
gfc_component *tmp_comp = NULL;
char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
- hidden_name = gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) tmp_sym->name[0]),
- &tmp_sym->name[1]);
+ if (!hidden)
+ {
+ hidden_name = gfc_get_string ("%c%s",
+ (char) TOUPPER ((unsigned char) name[0]),
+ &name[1]);
- /* Generate real derived type. */
- tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
- hidden_name);
-
- if (tmp_symtree != NULL)
- gcc_unreachable ();
- gfc_get_sym_tree (hidden_name, gfc_current_ns, &tmp_symtree, false);
- if (tmp_symtree)
- dt_sym = tmp_symtree->n.sym;
+ gcc_assert (gfc_find_symtree (gfc_current_ns->sym_root,
+ hidden_name) == NULL);
+
+ tmp_symtree = gfc_new_symtree (&gfc_current_ns->sym_root,
+ hidden_name);
+ }
else
- gcc_unreachable ();
+ tmp_symtree = gfc_get_unique_symtree (gfc_current_ns);
+
+ /* Generate real derived type. */
+ dt_sym = gfc_new_symbol (c_interop_kinds_table[s].name,
+ gfc_current_ns);
+ tmp_symtree->n.sym = dt_sym;
+ tmp_symtree->n.sym->refs++;
/* Generate an artificial generic function. */
dt_sym->name = gfc_get_string (tmp_sym->name);
@@ -4545,7 +4596,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
{
/* Create the necessary derived type so we can continue
processing the file. */
- generate_isocbinding_symbol (mod_name, c_ptr_id, NULL);
+ generate_isocbinding_symbol (mod_name, c_ptr_id, NULL,
+ true);
tmp_sym->ts.u.derived = get_iso_c_binding_dt (c_ptr_id);
}