]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/47023 (C_Sizeof: Rejects valid code)
authorJanus Weil <janus@gcc.gnu.org>
Tue, 18 Oct 2011 10:48:12 +0000 (12:48 +0200)
committerJanus Weil <janus@gcc.gnu.org>
Tue, 18 Oct 2011 10:48:12 +0000 (12:48 +0200)
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

gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/fortran/decl.c
gcc/fortran/gfortran.h
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/iso_c_binding_class.f03 [new file with mode: 0644]

index 8d2f4d6c30eb0b6168cbcb63bfea7d9f711e6d4f..7fe698812bf196dbfd7c0c1d2cda5d9b9e287a85 100644 (file)
@@ -1,3 +1,17 @@
+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>
            Dodji Seketeli  <dodji@redhat.com>
 
index 9b8ec21a7636678774b53bc4ed5a3b25dbd706f9..66e661bf659601a6a3cc5b163ef1a3ca2dee6832 100644 (file)
@@ -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",
index 9f3a39e56608cbb9b8ae66dc9e719bef62d6380c..2dd38b9485e78f8c0931d4db72be403199393ec1 100644 (file)
@@ -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)
index 1bd5ec36edd8832eaf38c7d035a7b950374c3d8c..da3477d7a0b0733cff13638a6b3528b29ee0d5b7 100644 (file)
@@ -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_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 9b76f98a562d671308abc5250705b6c65e7cdc00..0d7e03056b97dea402b43bf63c03fb5689043d1b 100644 (file)
@@ -2809,7 +2809,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
                         &(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 4b506fe83e80695866ac5369f7e6effb3273cc2c..587ad7cb3c9a6c0a832524c67d0d75c468385d54 100644 (file)
@@ -3635,7 +3635,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
       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 cbebb55393c539f7715e36d4bd775cde25aee0bd..db9417b9ddbddad45cb2aecc55d2040f7b4bc10a 100644 (file)
@@ -1,3 +1,8 @@
+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>
 
        * testsuite/lib/target-supports.exp
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_class.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_class.f03
new file mode 100644 (file)
index 0000000..bfb05bc
--- /dev/null
@@ -0,0 +1,15 @@
+! { 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