This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [Fortran-Experiments]: patch
Hi again,
talking about patches, what do you think of the following patch, which
adds the symbol name to gfc_add_is_bind_c. Several of the other
gfc_add_<attribute> functions have also a name argument.
Tobias
2007-02-26 Tobias Burnus <burnus@net-b.de>
* fortran/symbol.c (gfc_add_is_bind_c): Add symbol name as argument.
(gfc_copy_attr): Update gfc_add_is_bind_c call.
* fortran/decl.c (match_attr_spec,set_verify_bind_c_sym,
gfc_match_suffix,gfc_match_subroutine,gfc_get_type_attr_spec): Ditto.
* fortran/gfortran.h: Update gfc_add_is_bind_c prototype.
Index: symbol.c
===================================================================
*** symbol.c (revision 122336)
--- symbol.c (working copy)
*************** gfc_add_access (symbol_attribute * attr,
*** 1257,1263 ****
/* Set the is_bind_c field for the given symbol_attribute. */
try
! gfc_add_is_bind_c (symbol_attribute *attr, locus *where,
int is_proc_lang_bind_spec)
{
if (is_proc_lang_bind_spec == 0 && attr->flavor == FL_PROCEDURE)
--- 1259,1265 ----
/* Set the is_bind_c field for the given symbol_attribute. */
try
! gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
int is_proc_lang_bind_spec)
{
if (is_proc_lang_bind_spec == 0 && attr->flavor == FL_PROCEDURE)
*************** gfc_add_is_bind_c (symbol_attribute *att
*** 1276,1282 ****
== FAILURE)
return FAILURE;
! return check_conflict (attr, NULL, where);
}
--- 1278,1284 ----
== FAILURE)
return FAILURE;
! return check_conflict (attr, name, where);
}
*************** gfc_copy_attr (symbol_attribute * dest,
*** 1457,1465 ****
dest->intrinsic = 1;
is_proc_lang_bind_spec = (src->flavor == FL_PROCEDURE ? 1 : 0);
! if (src->is_bind_c && gfc_add_is_bind_c (dest, where, is_proc_lang_bind_spec)
! != SUCCESS)
return FAILURE;
if (src->is_c_interop)
dest->is_c_interop = 1;
if (src->is_iso_c)
--- 1459,1469 ----
dest->intrinsic = 1;
is_proc_lang_bind_spec = (src->flavor == FL_PROCEDURE ? 1 : 0);
! if (src->is_bind_c
! && gfc_add_is_bind_c (dest, NULL, where, is_proc_lang_bind_spec)
! != SUCCESS)
return FAILURE;
+
if (src->is_c_interop)
dest->is_c_interop = 1;
if (src->is_iso_c)
Index: decl.c
===================================================================
*** decl.c (revision 122336)
--- decl.c (working copy)
*************** match_attr_spec (void)
*** 2683,2689 ****
break;
case DECL_IS_BIND_C:
! t = gfc_add_is_bind_c(¤t_attr, &seen_at[d], 0);
break;
case DECL_VALUE:
--- 2683,2689 ----
break;
case DECL_IS_BIND_C:
! t = gfc_add_is_bind_c(¤t_attr, NULL, &seen_at[d], 0);
break;
case DECL_VALUE:
*************** set_verify_bind_c_sym (gfc_symbol *tmp_s
*** 2931,2937 ****
/* TODO: Do we need to make sure the vars aren't marked private? */
/* Set the is_bind_c bit in symbol_attribute. */
! gfc_add_is_bind_c (&(tmp_sym->attr), &gfc_current_locus, 0);
if (set_binding_label (tmp_sym->binding_label, tmp_sym->name,
num_idents) != SUCCESS)
--- 2931,2937 ----
/* TODO: Do we need to make sure the vars aren't marked private? */
/* Set the is_bind_c bit in symbol_attribute. */
! gfc_add_is_bind_c (&(tmp_sym->attr), tmp_sym->name, &gfc_current_locus, 0);
if (set_binding_label (tmp_sym->binding_label, tmp_sym->name,
num_idents) != SUCCESS)
*************** gfc_match_suffix (gfc_symbol *sym, gfc_s
*** 3698,3704 ****
}
if (is_bind_c == MATCH_YES)
! if (gfc_add_is_bind_c (&(sym->attr), &gfc_current_locus, 1)
== FAILURE)
return MATCH_ERROR;
--- 3698,3704 ----
}
if (is_bind_c == MATCH_YES)
! if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
== FAILURE)
return MATCH_ERROR;
*************** gfc_match_subroutine (void)
*** 4133,4139 ****
gfc_error ("Missing required parentheses before BIND(C) at %C");
return MATCH_ERROR;
}
! if (gfc_add_is_bind_c (&(sym->attr), &(sym->declared_at), 1) == FAILURE)
return MATCH_ERROR;
}
--- 4133,4140 ----
gfc_error ("Missing required parentheses before BIND(C) at %C");
return MATCH_ERROR;
}
! if (gfc_add_is_bind_c (&(sym->attr), sym->name, &(sym->declared_at), 1)
! == FAILURE)
return MATCH_ERROR;
}
*************** gfc_get_type_attr_spec (symbol_attribute
*** 5479,5485 ****
sure that all fields are interoperable. This will
need to be a semantic check on the finished derived type.
sect. 15.2.3 (lines 9-12) of f03 draft */
! if (gfc_add_is_bind_c (attr, &gfc_current_locus, 0) != SUCCESS)
return MATCH_ERROR;
/* TODO!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
--- 5480,5486 ----
sure that all fields are interoperable. This will
need to be a semantic check on the finished derived type.
sect. 15.2.3 (lines 9-12) of f03 draft */
! if (gfc_add_is_bind_c (attr, NULL, &gfc_current_locus, 0) != SUCCESS)
return MATCH_ERROR;
/* TODO!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
Index: gfortran.h
===================================================================
*** gfortran.h (revision 122336)
--- gfortran.h (working copy)
*************** try gfc_add_subroutine (symbol_attribute
*** 1981,1987 ****
try gfc_add_volatile (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
! try gfc_add_is_bind_c(symbol_attribute *attr, locus *where,
int is_proc_lang_bind_spec);
try gfc_add_value (symbol_attribute *, const char *, locus *);
try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
--- 1981,1987 ----
try gfc_add_volatile (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
! try gfc_add_is_bind_c(symbol_attribute *, const char *,locus *,
int is_proc_lang_bind_spec);
try gfc_add_value (symbol_attribute *, const char *, locus *);
try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);