Commit 00820a2a by Janus Weil

re PR fortran/47023 (C_Sizeof: Rejects valid code)

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.

From-SVN: r180130
parent fc8396e9
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-15 Tom Tromey <tromey@redhat.com> 2011-10-15 Tom Tromey <tromey@redhat.com>
Dodji Seketeli <dodji@redhat.com> Dodji Seketeli <dodji@redhat.com>
......
...@@ -3455,7 +3455,7 @@ gfc_check_sizeof (gfc_expr *arg ATTRIBUTE_UNUSED) ...@@ -3455,7 +3455,7 @@ gfc_check_sizeof (gfc_expr *arg ATTRIBUTE_UNUSED)
gfc_try gfc_try
gfc_check_c_sizeof (gfc_expr *arg) 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 " gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
"interoperable data entity", "interoperable data entity",
......
...@@ -961,7 +961,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) ...@@ -961,7 +961,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
across platforms. */ across platforms. */
gfc_try gfc_try
verify_c_interop_param (gfc_symbol *sym) gfc_verify_c_interop_param (gfc_symbol *sym)
{ {
int is_c_interop = 0; int is_c_interop = 0;
gfc_try retval = SUCCESS; gfc_try retval = SUCCESS;
...@@ -1000,20 +1000,24 @@ verify_c_interop_param (gfc_symbol *sym) ...@@ -1000,20 +1000,24 @@ verify_c_interop_param (gfc_symbol *sym)
{ {
if (sym->ns->proc_name->attr.is_bind_c == 1) if (sym->ns->proc_name->attr.is_bind_c == 1)
{ {
is_c_interop = is_c_interop = (gfc_verify_c_interop (&(sym->ts)) == SUCCESS ? 1 : 0);
(verify_c_interop (&(sym->ts))
== SUCCESS ? 1 : 0);
if (is_c_interop != 1) if (is_c_interop != 1)
{ {
/* Make personalized messages to give better feedback. */ /* Make personalized messages to give better feedback. */
if (sym->ts.type == BT_DERIVED) if (sym->ts.type == BT_DERIVED)
gfc_error ("Type '%s' at %L is a parameter to the BIND(C) " gfc_error ("Variable '%s' at %L is a dummy argument to the "
"procedure '%s' but is not C interoperable " "BIND(C) procedure '%s' but is not C interoperable "
"because derived type '%s' is not C interoperable", "because derived type '%s' is not C interoperable",
sym->name, &(sym->declared_at), sym->name, &(sym->declared_at),
sym->ns->proc_name->name, sym->ns->proc_name->name,
sym->ts.u.derived->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 else
gfc_warning ("Variable '%s' at %L is a parameter to the " gfc_warning ("Variable '%s' at %L is a parameter to the "
"BIND(C) procedure '%s' but may not be C " "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) ...@@ -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. */ /* Verify that the given gfc_typespec is for a C interoperable type. */
gfc_try gfc_try
verify_c_interop (gfc_typespec *ts) gfc_verify_c_interop (gfc_typespec *ts)
{ {
if (ts->type == BT_DERIVED && ts->u.derived != NULL) if (ts->type == BT_DERIVED && ts->u.derived != NULL)
return (ts->u.derived->ts.is_c_interop || ts->u.derived->attr.is_bind_c) return (ts->u.derived->ts.is_c_interop || ts->u.derived->attr.is_bind_c)
? SUCCESS : FAILURE; ? SUCCESS : FAILURE;
else if (ts->type == BT_CLASS)
return FAILURE;
else if (ts->is_c_interop != 1) else if (ts->is_c_interop != 1)
return FAILURE; return FAILURE;
...@@ -3788,7 +3794,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, ...@@ -3788,7 +3794,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
the given ts (current_ts), so look in both. */ the given ts (current_ts), so look in both. */
if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN) 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. */ /* See if we're dealing with a sym in a common block or not. */
if (is_in_common == 1) if (is_in_common == 1)
......
...@@ -2581,8 +2581,8 @@ gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *); ...@@ -2581,8 +2581,8 @@ gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); 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_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **); int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
gfc_try verify_c_interop (gfc_typespec *); gfc_try gfc_verify_c_interop (gfc_typespec *);
gfc_try verify_c_interop_param (gfc_symbol *); 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_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
gfc_try verify_bind_c_derived_type (gfc_symbol *); gfc_try verify_bind_c_derived_type (gfc_symbol *);
gfc_try verify_com_block_vars_c_interop (gfc_common_head *); gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
......
...@@ -2809,7 +2809,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, ...@@ -2809,7 +2809,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
&(args->expr->where)); &(args->expr->where));
/* See if we have interoperable type and type param. */ /* 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) || gfc_check_any_c_kind (arg_ts) == SUCCESS)
{ {
if (args_sym->attr.target == 1) if (args_sym->attr.target == 1)
...@@ -10544,7 +10544,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) ...@@ -10544,7 +10544,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
{ {
/* Skip implicitly typed dummy args here. */ /* Skip implicitly typed dummy args here. */
if (curr_arg->sym->attr.implicit_type == 0) 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 /* If something is found to fail, record the fact so we
can mark the symbol for the procedure as not being can mark the symbol for the procedure as not being
BIND(C) to try and prevent multiple errors being BIND(C) to try and prevent multiple errors being
......
...@@ -3635,7 +3635,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) ...@@ -3635,7 +3635,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
else else
{ {
/* Grab the typespec for the given component and test the kind. */ /* 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) if (is_c_interop != SUCCESS)
{ {
......
2011-10-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/47023
* gfortran.dg/iso_c_binding_class.f03: New.
2011-10-18 Ira Rosen <ira.rosen@linaro.org> 2011-10-18 Ira Rosen <ira.rosen@linaro.org>
* testsuite/lib/target-supports.exp * testsuite/lib/target-supports.exp
......
! { dg-do compile }
!
! PR 47023: C_Sizeof: Rejects valid code
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
use iso_c_binding
type t
integer(c_int) :: i
end type t
contains
subroutine test(a) bind(c) ! { dg-error "is not C interoperable" }
class(t) :: a
end subroutine
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment