diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-10-18 10:48:12 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-10-18 10:48:12 +0000 |
| commit | 2564c57aa75e21e790b92f3add7507381d2ebbc9 (patch) | |
| tree | 148eaa9b42a6e2b9cba8c5f9681b188b9ea70790 /gcc/fortran/decl.c | |
| parent | 326e339126fb6755a3ebaf6b932e0c2eca8745d8 (diff) | |
| download | gcc-2564c57aa75e21e790b92f3add7507381d2ebbc9.tar.gz | |
2011-10-18 Janus Weil <janus@gcc.gnu.org>
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-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/47023
* gfortran.dg/iso_c_binding_class.f03: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180130 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 9f3a39e5660..2dd38b9485e 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -961,7 +961,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) 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 @@ verify_c_interop_param (gfc_symbol *sym) { 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, int is_bind_c) /* 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_typespec *ts, 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) |