Hi all, here is another patch for PR47023, which takes care of comment #1, i.e. rejecting polymorphic variables in a C-binding context. It also adapts two functions (verify_c_interop,verify_c_interop_param) to the gfortran naming convention of prefixing public routines with 'gfc_', and fixes an error message which had incorrect wording. The only nontrivial part of the patch is in decl.c (the rest is just renaming).
Regtested on x86_64-unknown-linux-gnu. Ok for trunk? Cheers, Janus 2011-10-17 Janus Weil <[email protected]> PR fortran/47023 * decl.c (verify_c_interop_param): Renamed to 'gfc_verify_c_interop_param'. Add error message for polymorphic arguments. (verify_c_interop): Renamed to 'gfc_verify_c_interop'. Reject polymorphic variables. (verify_bind_c_sym): Renamed 'verify_c_interop'. * gfortran.h (verify_c_interop,verify_c_interop_param): Renamed. * check.c (gfc_check_sizeof): Ditto. * resolve.c (gfc_iso_c_func_interface,resolve_fl_procedure): Ditto. * symbol.c (verify_bind_c_derived_type): Ditto. 2011-10-17 Janus Weil <[email protected]> PR fortran/47023 * gfortran.dg/iso_c_binding_class.f03: New.
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 180078)
+++ gcc/fortran/symbol.c (working copy)
@@ -3635,7 +3635,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sy
else
{
/* Grab the typespec for the given component and test the kind. */
- is_c_interop = verify_c_interop (&(curr_comp->ts));
+ is_c_interop = gfc_verify_c_interop (&(curr_comp->ts));
if (is_c_interop != SUCCESS)
{
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 180078)
+++ gcc/fortran/decl.c (working copy)
@@ -961,7 +961,7 @@ get_proc_name (const char *name, gfc_symbol **resu
across platforms. */
gfc_try
-verify_c_interop_param (gfc_symbol *sym)
+gfc_verify_c_interop_param (gfc_symbol *sym)
{
int is_c_interop = 0;
gfc_try retval = SUCCESS;
@@ -1000,20 +1000,24 @@ gfc_try
{
if (sym->ns->proc_name->attr.is_bind_c == 1)
{
- is_c_interop =
- (verify_c_interop (&(sym->ts))
- == SUCCESS ? 1 : 0);
+ is_c_interop = (gfc_verify_c_interop (&(sym->ts)) == SUCCESS ? 1 : 0);
if (is_c_interop != 1)
{
/* Make personalized messages to give better feedback. */
if (sym->ts.type == BT_DERIVED)
- gfc_error ("Type '%s' at %L is a parameter to the BIND(C) "
- "procedure '%s' but is not C interoperable "
+ gfc_error ("Variable '%s' at %L is a dummy argument to the "
+ "BIND(C) procedure '%s' but is not C interoperable "
"because derived type '%s' is not C interoperable",
sym->name, &(sym->declared_at),
sym->ns->proc_name->name,
sym->ts.u.derived->name);
+ else if (sym->ts.type == BT_CLASS)
+ gfc_error ("Variable '%s' at %L is a dummy argument to the "
+ "BIND(C) procedure '%s' but is not C interoperable "
+ "because it is polymorphic",
+ sym->name, &(sym->declared_at),
+ sym->ns->proc_name->name);
else
gfc_warning ("Variable '%s' at %L is a parameter to the "
"BIND(C) procedure '%s' but may not be C "
@@ -3711,11 +3715,13 @@ set_com_block_bind_c (gfc_common_head *com_block,
/* Verify that the given gfc_typespec is for a C interoperable type. */
gfc_try
-verify_c_interop (gfc_typespec *ts)
+gfc_verify_c_interop (gfc_typespec *ts)
{
if (ts->type == BT_DERIVED && ts->u.derived != NULL)
return (ts->u.derived->ts.is_c_interop || ts->u.derived->attr.is_bind_c)
? SUCCESS : FAILURE;
+ else if (ts->type == BT_CLASS)
+ return FAILURE;
else if (ts->is_c_interop != 1)
return FAILURE;
@@ -3788,7 +3794,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typesp
the given ts (current_ts), so look in both. */
if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN)
{
- if (verify_c_interop (&(tmp_sym->ts)) != SUCCESS)
+ if (gfc_verify_c_interop (&(tmp_sym->ts)) != SUCCESS)
{
/* See if we're dealing with a sym in a common block or not. */
if (is_in_common == 1)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 180078)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2581,8 +2581,8 @@ gfc_symtree* gfc_find_symtree_in_proc (const char
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
-gfc_try verify_c_interop (gfc_typespec *);
-gfc_try verify_c_interop_param (gfc_symbol *);
+gfc_try gfc_verify_c_interop (gfc_typespec *);
+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 *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 180078)
+++ gcc/fortran/resolve.c (working copy)
@@ -2809,7 +2809,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_act
&(args->expr->where));
/* See if we have interoperable type and type param. */
- if (verify_c_interop (arg_ts) == SUCCESS
+ if (gfc_verify_c_interop (arg_ts) == SUCCESS
|| gfc_check_any_c_kind (arg_ts) == SUCCESS)
{
if (args_sym->attr.target == 1)
@@ -10544,7 +10544,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag
{
/* Skip implicitly typed dummy args here. */
if (curr_arg->sym->attr.implicit_type == 0)
- if (verify_c_interop_param (curr_arg->sym) == FAILURE)
+ if (gfc_verify_c_interop_param (curr_arg->sym) == FAILURE)
/* If something is found to fail, record the fact so we
can mark the symbol for the procedure as not being
BIND(C) to try and prevent multiple errors being
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 180078)
+++ gcc/fortran/check.c (working copy)
@@ -3455,7 +3455,7 @@ gfc_check_sizeof (gfc_expr *arg ATTRIBUTE_UNUSED)
gfc_try
gfc_check_c_sizeof (gfc_expr *arg)
{
- if (verify_c_interop (&arg->ts) != SUCCESS)
+ if (gfc_verify_c_interop (&arg->ts) != SUCCESS)
{
gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
"interoperable data entity",
iso_c_binding_class.f03
Description: Binary data
