* [Patch, fortran] [4/4] C binding access to C_PTR type: main fix
2013-03-02 16:54 [Patch, fortran] [0/4] PR55574: C binding access to C_PTR type Mikael Morin
@ 2013-03-02 16:54 ` Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [3/4] C binding access to C_PTR type: don't do name lookup in gen_special_c_interop_ptr Mikael Morin
` (2 subsequent siblings)
3 siblings, 0 replies; 5+ messages in thread
From: Mikael Morin @ 2013-03-02 16:54 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 1050 bytes --]
This is the main part of the patch.
A new argument "hidden" is added to generate_isocbinding_symbol, telling whether
we want the symbol accessible or not.
The code trying to reuse existing symbols is rewritten as follows:
- A big condition containing two internal assignments is extracted into a new
function: check_iso_c_symbol.
- We make two attempts to look for the symbol, and use the new function to check
for symbol match each time. First, we try to find the symbol under its local
(possibly renamed) name. Then we fall back to look it up under its real name.
The code creating new symtrees doesn't use gfc_get_sym_tree anymore, as it
wouldn't honor "hidden"; it uses either gfc_new_symtree or
gfc_get_unique_symtree instead, depending on "hidden".
The same is done in the hunk dealing with creating the derived type symtree
(accessible with a capitalized first letter name). I also changed tmp_sym->name
to name there as it made more sense to me (local name instead of real one). I'm
not completely sure that it's correct though.
[-- Attachment #2: pr55574_v20-4.CL --]
[-- Type: text/plain, Size: 464 bytes --]
2013-03-02 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/55574
* gfortran.h (generate_isocbinding_symbol): New argument in prototype.
* module.c (import_iso_c_binding_module): Update calls to
generate_isocbinding_symbol.
* symbol.c (gen_special_c_interop_ptr, gen_cptr_param): Ditto.
(check_iso_c_symbol): New function.
(generate_isocbinding_symbol): New argument 'hidden'.
Rewrite existing symbol lookup. Avoid namespace pollution if 'hidden'
is set.
[-- Attachment #3: pr55574_v20-4.patch --]
[-- Type: text/x-diff, Size: 7962 bytes --]
diff --git a/gfortran.h b/gfortran.h
index 44d5c91..89f4f73 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -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 **);
diff --git a/module.c b/module.c
index 1b38555..062cf81 100644
--- a/module.c
+++ b/module.c
@@ -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);
}
}
}
diff --git a/symbol.c b/symbol.c
index b03d572..4244fda 100644
--- a/symbol.c
+++ b/symbol.c
@@ -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);
}
[-- Attachment #4: pr55574-test.CL --]
[-- Type: text/plain, Size: 117 bytes --]
2013-03-02 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/55574
* gfortran.dg/iso_c_binding_only_2.f03: New test.
[-- Attachment #5: iso_c_binding_only_2.f03 --]
[-- Type: text/plain, Size: 393 bytes --]
! { dg-do compile }
!
! PR fortran/55574
! The following code used to be accepted because C_LOC pulls in C_PTR
! implicitly.
!
! Contributed by Valery Weber <valeryweber@hotmail.com>
!
program aaaa
use iso_c_binding, only : c_loc
integer, target :: i
type(C_PTR) :: f_ptr ! { dg-error "being used before it is defined" }
f_ptr=c_loc(i) ! { dg-error "Can't convert" }
end program aaaa
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Patch, fortran] [0/4] PR55574: C binding access to C_PTR type
@ 2013-03-02 16:54 Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [4/4] C binding access to C_PTR type: main fix Mikael Morin
` (3 more replies)
0 siblings, 4 replies; 5+ messages in thread
From: Mikael Morin @ 2013-03-02 16:54 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 1149 bytes --]
Hello,
as promised, here comes the patch for PR55574, where for code like:
use iso_c_binding, only : c_loc
type(C_PTR) :: f_ptr
the second statement is accepted despite c_ptr not being use-associated, as
c_loc implicitly pulls-in c_ptr.
This regression comes from Tobias' "constructor" patch (support for generics
with the same name as a derived type), which changed mangled names
"_gfortran_iso_c_binding_c_ptr" to real names "c_ptr".
The fix proposed here adds a "hidden" argument to `generate_isocbinding_symbol',
so that we know whether the symbol should be made accessible or not.
Then, we use either `gfc_new_symtree' or `gfc_get_unique_symtree' to create
the new symtree, depending on the "hidden" argument.
The work is divided as below in the follow-up mails. The full diff is also
attached to this one.
1/4: Preliminary cleanups.
2/4: Use get_iso_c_binding_dt instead of gfc_get_ha_symbol in gen_cptr_param
3/4: Don't do again name to symbol resolution in gen_special_c_interop_ptr
4/4: (main part) Fix symbol name handling in generate_isocbinding_symbol.
Regression tested on x86_64-unknown-linux-gnu. Ok for 4.8/4.7 ?
Mikael
[-- Attachment #2: pr55574_v20-full.diff --]
[-- Type: text/x-diff, Size: 13365 bytes --]
diff --git a/gfortran.h b/gfortran.h
index 44d5c91..89f4f73 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -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 **);
diff --git a/module.c b/module.c
index 1b38555..062cf81 100644
--- a/module.c
+++ b/module.c
@@ -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);
}
}
}
diff --git a/symbol.c b/symbol.c
index acfebc5..4244fda 100644
--- a/symbol.c
+++ b/symbol.c
@@ -3811,23 +3811,11 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
/* Generate symbols for the named constants c_null_ptr and c_null_funptr. */
static gfc_try
-gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
- const char *module_name)
+gen_special_c_interop_ptr (int ptr_id, gfc_symbol *tmp_sym,
+ const char *module_name)
{
- gfc_symtree *tmp_symtree;
- gfc_symbol *tmp_sym;
gfc_constructor *c;
-
- tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
-
- if (tmp_symtree != NULL)
- tmp_sym = tmp_symtree->n.sym;
- else
- {
- tmp_sym = NULL;
- gfc_internal_error ("gen_special_c_interop_ptr(): Unable to "
- "create symbol for %s", ptr_name);
- }
+ iso_c_binding_symbol type_id;
tmp_sym->ts.is_c_interop = 1;
tmp_sym->attr.is_c_interop = 1;
@@ -3838,25 +3826,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, true);
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (type_id);
}
/* Module name is some mangled version of iso_c_binding. */
@@ -3928,12 +3910,7 @@ gen_cptr_param (gfc_formal_arglist **head,
gfc_symtree *param_symtree = NULL;
gfc_formal_arglist *formal_arg = NULL;
const char *c_ptr_in;
- const char *c_ptr_type = NULL;
-
- if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
- c_ptr_type = "c_funptr";
- else
- c_ptr_type = "c_ptr";
+ iso_c_binding_symbol c_ptr_id;
if(c_ptr_name == NULL)
c_ptr_in = "gfc_cptr__";
@@ -3957,24 +3934,19 @@ 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);
-
- gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
+ trying to use one of the iso_c_binding functions that need it. */
+ generate_isocbinding_symbol (module_name, c_ptr_id, NULL, true);
+ c_ptr_sym = get_iso_c_binding_dt (c_ptr_id);
}
param_sym->ts.u.derived = c_ptr_sym;
@@ -4276,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
@@ -4289,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;
@@ -4300,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);
@@ -4420,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]);
+
+ gcc_assert (gfc_find_symtree (gfc_current_ns->sym_root,
+ hidden_name) == NULL);
- /* 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;
+ 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);
@@ -4522,8 +4545,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
case ISOCBINDING_NULL_PTR:
case ISOCBINDING_NULL_FUNPTR:
- gen_special_c_interop_ptr (s, name, mod_name);
- break;
+ gen_special_c_interop_ptr (s, tmp_sym, mod_name);
+ break;
case ISOCBINDING_F_POINTER:
case ISOCBINDING_ASSOCIATED:
@@ -4556,31 +4579,26 @@ 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,
+ true);
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (c_ptr_id);
}
/* The function result is itself (no result clause). */
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Patch, fortran] [3/4] C binding access to C_PTR type: don't do name lookup in gen_special_c_interop_ptr
2013-03-02 16:54 [Patch, fortran] [0/4] PR55574: C binding access to C_PTR type Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [4/4] C binding access to C_PTR type: main fix Mikael Morin
@ 2013-03-02 16:54 ` Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [1/4] C binding access to C_PTR type: preliminary cleanups Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [2/4] C binding access to C_PTR type: use gfc_get_iso_c_binding_dt Mikael Morin
3 siblings, 0 replies; 5+ messages in thread
From: Mikael Morin @ 2013-03-02 16:54 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 258 bytes --]
This patch fixes gen_special_c_interop_ptr, which uses gfc_find_symtree to retrieve
the current symbol. Again, this is not safe to renaming and hiding, so this
patch passes the symbol directly, instead of passing its name and retrieving
the symbol from it.
[-- Attachment #2: pr55574_v20-3.CL --]
[-- Type: text/plain, Size: 202 bytes --]
2013-03-02 Mikael Morin <mikael@gcc.gnu.org>
* symbol.c (gen_special_c_interop_ptr): Retrieve symbol through
argument instead of symbol name lookup.
(generate_isocbinding_symbol): Update caller.
[-- Attachment #3: pr55574_v20-3.patch --]
[-- Type: text/x-diff, Size: 1379 bytes --]
diff --git a/symbol.c b/symbol.c
index 646ca9d..b03d572 100644
--- a/symbol.c
+++ b/symbol.c
@@ -3811,25 +3811,12 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
/* Generate symbols for the named constants c_null_ptr and c_null_funptr. */
static gfc_try
-gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
- const char *module_name)
+gen_special_c_interop_ptr (int ptr_id, gfc_symbol *tmp_sym,
+ const char *module_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);
-
- if (tmp_symtree != NULL)
- tmp_sym = tmp_symtree->n.sym;
- else
- {
- tmp_sym = NULL;
- gfc_internal_error ("gen_special_c_interop_ptr(): Unable to "
- "create symbol for %s", ptr_name);
- }
-
tmp_sym->ts.is_c_interop = 1;
tmp_sym->attr.is_c_interop = 1;
tmp_sym->ts.is_iso_c = 1;
@@ -4507,8 +4494,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
case ISOCBINDING_NULL_PTR:
case ISOCBINDING_NULL_FUNPTR:
- gen_special_c_interop_ptr (s, name, mod_name);
- break;
+ gen_special_c_interop_ptr (s, tmp_sym, mod_name);
+ break;
case ISOCBINDING_F_POINTER:
case ISOCBINDING_ASSOCIATED:
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Patch, fortran] [1/4] C binding access to C_PTR type: preliminary cleanups
2013-03-02 16:54 [Patch, fortran] [0/4] PR55574: C binding access to C_PTR type Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [4/4] C binding access to C_PTR type: main fix Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [3/4] C binding access to C_PTR type: don't do name lookup in gen_special_c_interop_ptr Mikael Morin
@ 2013-03-02 16:54 ` Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [2/4] C binding access to C_PTR type: use gfc_get_iso_c_binding_dt Mikael Morin
3 siblings, 0 replies; 5+ messages in thread
From: Mikael Morin @ 2013-03-02 16:54 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 486 bytes --]
This patch contains some preliminary cleanup.
- generate_isocbinding_symbol handles NULL symbol names just fine.
Thus, there is no need to pass explicitly the "c_ptr" or "c_funptr"
strings.
- There is a lot of code that looks like
if (cond)
{
foo (c_ptr);
bar (c_ptr);
}
else
{
foo (c_funptr);
bar (c_funptr);
}
That code is changed by this patch to:
if (cond)
ptr_id = c_ptr_id;
else
ptr_id = c_funptr_id;
foo (ptr_id);
bar (ptr_id);
[-- Attachment #2: pr55574_v20-1.CL --]
[-- Type: text/plain, Size: 213 bytes --]
2013-03-02 Mikael Morin <mikael@gcc.gnu.org>
* symbol.c (gen_special_c_interop_ptr, gen_cptr_param,
generate_isocbinding_symbol): Use symbol ID explicitly.
Pass a NULL string to generate_isocbinding_symbol.
[-- Attachment #3: pr55574_v20-1.patch --]
[-- Type: text/x-diff, Size: 5513 bytes --]
diff --git a/symbol.c b/symbol.c
index acfebc5..4e6004f 100644
--- a/symbol.c
+++ b/symbol.c
@@ -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). */
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Patch, fortran] [2/4] C binding access to C_PTR type: use gfc_get_iso_c_binding_dt
2013-03-02 16:54 [Patch, fortran] [0/4] PR55574: C binding access to C_PTR type Mikael Morin
` (2 preceding siblings ...)
2013-03-02 16:54 ` [Patch, fortran] [1/4] C binding access to C_PTR type: preliminary cleanups Mikael Morin
@ 2013-03-02 16:54 ` Mikael Morin
3 siblings, 0 replies; 5+ messages in thread
From: Mikael Morin @ 2013-03-02 16:54 UTC (permalink / raw)
To: gfortran, GCC patches
[-- Attachment #1: Type: text/plain, Size: 215 bytes --]
gen_cptr_param uses gfc_get_ha_symbol to retrieve the c_ptr symbol.
This is not safe to symbol renaming and to symbol hiding.
This patch changes it to use get_iso_c_binding_dt, which is the function used
elsewhere.
[-- Attachment #2: pr55574_v20-2.CL --]
[-- Type: text/plain, Size: 136 bytes --]
2013-03-02 Mikael Morin <mikael@gcc.gnu.org>
* symbol.c (gen_cptr_param): Retrieve pointer type symbol using
get_iso_c_binding_dt.
[-- Attachment #3: pr55574_v20-2.patch --]
[-- Type: text/x-diff, Size: 942 bytes --]
diff --git a/symbol.c b/symbol.c
index 4e6004f..646ca9d 100644
--- a/symbol.c
+++ b/symbol.c
@@ -3923,14 +3923,8 @@ gen_cptr_param (gfc_formal_arglist **head,
gfc_symtree *param_symtree = NULL;
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";
- else
- c_ptr_type = "c_ptr";
-
if(c_ptr_name == NULL)
c_ptr_in = "gfc_cptr__";
else
@@ -3965,7 +3959,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);
- gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
+ c_ptr_sym = get_iso_c_binding_dt (c_ptr_id);
}
param_sym->ts.u.derived = c_ptr_sym;
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2013-03-02 16:54 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-03-02 16:54 [Patch, fortran] [0/4] PR55574: C binding access to C_PTR type Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [4/4] C binding access to C_PTR type: main fix Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [3/4] C binding access to C_PTR type: don't do name lookup in gen_special_c_interop_ptr Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [1/4] C binding access to C_PTR type: preliminary cleanups Mikael Morin
2013-03-02 16:54 ` [Patch, fortran] [2/4] C binding access to C_PTR type: use gfc_get_iso_c_binding_dt Mikael Morin
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).