This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR 38160 - C Binding: Kind parameter checking too strict and too late


Hello,

Chris implemented some checking to ensure that one is using the right
type kind parameter for BIND(C), e.g.

subroutine foo(x) bind(x)
   real(c_int) :: x

prints the error:

subroutine foo(x) bind(C)
               1
Error: C kind parameter is for type INTEGER but symbol 'x' at (1) is of
type REAL

Similarly for
   complex(c_double) :: z
   ptr =  c_loc(z)

The latter is actually what is used in the Fortran bindings for the GNU
Scientific Library (FGSL). In principle, one should use here
c_double_complex, but as Steve noticed, the standard explicitly states
that c_(real) and c_(real)_complex have the same value.


Changes by the patch:

a) The diagnostic comes too late, i.e. I expect a message for
   complex(c_int) :: z
and not for
   c_loc(z)
Thus I changed this.

b) complex(c_double) is rejected although the kind type parameter is the
same as c_double_complex according to the standard.

c) I downgraded the error for "REAL(C_INT)" to a warning, but I can also
turn it again into a error; what do you think?


Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
2008-11-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/38160
	* trans-types.c (gfc_validate_c_kind): Remove function.
	* decl.c (gfc_match_kind_spec): Add C kind parameter check.
	  (verify_bind_c_derived_type): Remove gfc_validate_c_kind call.
	  (verify_c_interop_param): Update call.
	* gfortran.h (verify_bind_c_derived_type): Update prototype.
	  (gfc_validate_c_kind): Remove.
	* symbol.c (verify_bind_c_derived_type): Update verify_c_interop call.
	* resolve.c (gfc_iso_c_func_interface): Ditto.

2008-11-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/38160
	* gfortran.dg/bind_c_usage_18.f90: New test.
	* gfortran.dg/c_kind_tests_2.f03: Update dg-messages.
	* gfortran.dg/interop_params.f03: Ditto.

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 141918)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -3003,6 +3003,24 @@ gfc_free_finalizer_list (gfc_finalizer*
 }
 
 
+/* Free the charlen list from cl to end (end is not freed). 
+   Free the whole list if end is NULL.  */
+
+void gfc_free_charlen (gfc_charlen *cl, gfc_charlen *end)
+{
+  gfc_charlen *cl2;
+
+  for (; cl != end; cl = cl2)
+    {
+      gcc_assert (cl);
+
+      cl2 = cl->next;
+      gfc_free_expr (cl->length);
+      gfc_free (cl);
+    }
+}
+
+
 /* Free a namespace structure and everything below it.  Interface
    lists associated with intrinsic operators are not freed.  These are
    taken care of when a specific name is freed.  */
@@ -3010,7 +3028,6 @@ gfc_free_finalizer_list (gfc_finalizer*
 void
 gfc_free_namespace (gfc_namespace *ns)
 {
-  gfc_charlen *cl, *cl2;
   gfc_namespace *p, *q;
   gfc_intrinsic_op i;
 
@@ -3028,14 +3045,7 @@ gfc_free_namespace (gfc_namespace *ns)
   free_uop_tree (ns->uop_root);
   free_common_tree (ns->common_root);
   gfc_free_finalizer_list (ns->finalizers);
-
-  for (cl = ns->cl_list; cl; cl = cl2)
-    {
-      cl2 = cl->next;
-      gfc_free_expr (cl->length);
-      gfc_free (cl);
-    }
-
+  gfc_free_charlen (ns->cl_list, NULL);
   free_st_labels (ns->st_labels);
 
   gfc_free_equiv (ns->equiv);
@@ -3385,8 +3395,7 @@ verify_bind_c_derived_type (gfc_symbol *
       else
 	{
 	  /* Grab the typespec for the given component and test the kind.  */ 
-	  is_c_interop = verify_c_interop (&(curr_comp->ts), curr_comp->name,
-                                           &(curr_comp->loc));
+	  is_c_interop = verify_c_interop (&(curr_comp->ts));
 	  
 	  if (is_c_interop != SUCCESS)
 	    {
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(Revision 141918)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -918,7 +918,7 @@ 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), sym->name, &(sym->declared_at))
+	    (verify_c_interop (&(sym->ts))
 	     == SUCCESS ? 1 : 0);
 
 	  if (is_c_interop != 1)
@@ -1982,6 +1982,17 @@ kind_expr:
       return MATCH_ERROR;
     }
 
+  /* Warn if, e.g., c_int is used for a REAL variable, but not
+     if, e.g., c_double is used for COMPLEX as the standard
+     explicitly says that the kind type parameter for complex and real
+     variable is the same, i.e. c_float == c_float_complex.  */
+  if (ts->f90_type != BT_UNKNOWN && ts->f90_type != ts->type
+      && !((ts->f90_type == BT_REAL && ts->type == BT_COMPLEX)
+	   || (ts->f90_type == BT_COMPLEX && ts->type == BT_REAL)))
+    gfc_warning ("C kind type parameter is for type %s but type at %L is %s",
+		 gfc_basic_typename (ts->f90_type), &where,
+		 gfc_basic_typename (ts->type));
+
   gfc_gobble_whitespace ();
   if ((c = gfc_next_ascii_char ()) != ')'
       && (ts->type != BT_CHARACTER || c != ','))
@@ -3299,29 +3310,8 @@ set_com_block_bind_c (gfc_common_head *c
 /* Verify that the given gfc_typespec is for a C interoperable type.  */
 
 gfc_try
-verify_c_interop (gfc_typespec *ts, const char *name, locus *where)
+verify_c_interop (gfc_typespec *ts)
 {
-  gfc_try t;
-
-  /* Make sure the kind used is appropriate for the type.
-     The f90_type is unknown if an integer constant was
-     used (e.g., real(4), bind(c) :: myFloat).  */
-  if (ts->f90_type != BT_UNKNOWN)
-    {
-      t = gfc_validate_c_kind (ts);
-      if (t != SUCCESS)
-        {
-          /* Print an error, but continue parsing line.  */
-          gfc_error_now ("C kind parameter is for type %s but "
-                         "symbol '%s' at %L is of type %s",
-                         gfc_basic_typename (ts->f90_type),
-                         name, where, 
-                         gfc_basic_typename (ts->type));
-        }
-    }
-
-  /* Make sure the kind is C interoperable.  This does not care about the
-     possible error above.  */
   if (ts->type == BT_DERIVED && ts->derived != NULL)
     return (ts->derived->ts.is_c_interop ? SUCCESS : FAILURE);
   else if (ts->is_c_interop != 1)
@@ -3396,8 +3386,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym,
      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), tmp_sym->name,
-                            &(tmp_sym->declared_at)) != SUCCESS)
+      if (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 141918)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -1285,7 +1285,7 @@ typedef struct gfc_namespace
      this namespace.  */
   struct gfc_data *data;
 
-  gfc_charlen *cl_list;
+  gfc_charlen *cl_list, *old_cl_list;
 
   int save_all, seen_save, seen_implicit_none;
 
@@ -2215,7 +2215,6 @@ arith gfc_check_integer_range (mpz_t p,
 bool gfc_check_character_range (gfc_char_t, int);
 
 /* trans-types.c */
-gfc_try gfc_validate_c_kind (gfc_typespec *);
 gfc_try gfc_check_any_c_kind (gfc_typespec *);
 int gfc_validate_kind (bt, int, bool);
 extern int gfc_index_integer_kind;
@@ -2319,7 +2318,7 @@ gfc_symbol *gfc_new_symbol (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 *, const char *name, locus *where);
+gfc_try verify_c_interop (gfc_typespec *);
 gfc_try 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 *);
@@ -2335,6 +2334,7 @@ int gfc_symbols_could_alias (gfc_symbol
 void gfc_undo_symbols (void);
 void gfc_commit_symbols (void);
 void gfc_commit_symbol (gfc_symbol *);
+void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
 void gfc_free_namespace (gfc_namespace *);
 
 void gfc_symbol_init_2 (void);
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(Revision 141918)
+++ gcc/fortran/trans-types.c	(Arbeitskopie)
@@ -117,20 +117,6 @@ int gfc_numeric_storage_size;
 int gfc_character_storage_size;
 
 
-/* Validate that the f90_type of the given gfc_typespec is valid for
-   the type it represents.  The f90_type represents the Fortran types
-   this C kind can be used with.  For example, c_int has a f90_type of
-   BT_INTEGER and c_float has a f90_type of BT_REAL.  Returns FAILURE
-   if a mismatch occurs between ts->f90_type and ts->type; SUCCESS if
-   they match.  */
-
-gfc_try
-gfc_validate_c_kind (gfc_typespec *ts)
-{
-   return ((ts->type == ts->f90_type) ? SUCCESS : FAILURE);
-}
-
-
 gfc_try
 gfc_check_any_c_kind (gfc_typespec *ts)
 {
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 141918)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -2072,10 +2072,7 @@ gfc_iso_c_func_interface (gfc_symbol *sy
             }
 
           /* See if we have interoperable type and type param.  */
-          if (verify_c_interop (arg_ts,
-				(parent_ref ? parent_ref->u.c.component->name 
-				 : args_sym->name), 
-                                &(args->expr->where)) == SUCCESS
+          if (verify_c_interop (arg_ts) == SUCCESS
               || gfc_check_any_c_kind (arg_ts) == SUCCESS)
             {
               if (args_sym->attr.target == 1)
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(Revision 141918)
+++ gcc/fortran/parse.c	(Arbeitskopie)
@@ -807,6 +807,7 @@ next_statement (void)
   locus old_locus;
   gfc_new_block = NULL;
 
+  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
   for (;;)
     {
       gfc_statement_label = NULL;
@@ -1512,6 +1513,10 @@ accept_statement (gfc_statement st)
 static void
 reject_statement (void)
 {
+  /* Revert to the previous charlen chain.  */
+  gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
+  gfc_current_ns->cl_list = gfc_current_ns->old_cl_list;
+
   gfc_new_block = NULL;
   gfc_undo_symbols ();
   gfc_clear_warning ();
Index: gcc/testsuite/gfortran.dg/c_kind_tests_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_kind_tests_2.f03	(Revision 141918)
+++ gcc/testsuite/gfortran.dg/c_kind_tests_2.f03	(Arbeitskopie)
@@ -4,11 +4,11 @@ module c_kind_tests_2
 
   integer, parameter :: myF = c_float
   real(myF), bind(c) :: myCFloat
-  integer(myF), bind(c) :: myCInt ! { dg-error "is for type REAL" }
-  integer(c_double), bind(c) :: myCInt2 ! { dg-error "is for type REAL" }
+  integer(myF), bind(c) :: myCInt       ! { dg-warning "is for type REAL" }
+  integer(c_double), bind(c) :: myCInt2 ! { dg-warning "is for type REAL" }
 
   integer, parameter :: myI = c_int
-  real(myI) :: myReal
-  real(myI), bind(c) :: myCFloat2 ! { dg-error "is for type INTEGER" }
-  real(4), bind(c) :: myFloat ! { dg-warning "may not be a C interoperable" }
+  real(myI) :: myReal             ! { dg-warning "is for type INTEGER" }
+  real(myI), bind(c) :: myCFloat2 ! { dg-warning "is for type INTEGER" }
+  real(4), bind(c) :: myFloat     ! { dg-warning "may not be a C interoperable" }
 end module c_kind_tests_2
Index: gcc/testsuite/gfortran.dg/bind_c_usage_18.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bind_c_usage_18.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/bind_c_usage_18.f90	(Revision 0)
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR fortran/38160
+!
+
+subroutine foo(x,y,z,a) bind(c) ! { dg-warning "but may not be C interoperable" }
+  use iso_c_binding
+  implicit none
+  integer(4) :: x
+  integer(c_float) :: y ! { dg-warning "C kind type parameter is for type REAL" }
+  complex(c_float) :: z ! OK, c_float == c_float_complex
+  real(c_float_complex) :: a ! OK, c_float == c_float_complex
+end subroutine foo
+
+use iso_c_binding
+implicit none
+integer, parameter :: it = c_int
+integer, parameter :: dt = c_double
+complex(c_int), target    :: z1  ! { dg-warning "C kind type parameter is for type INTEGER" }
+complex(it), target       :: z2  ! { dg-warning "C kind type parameter is for type INTEGER" }
+complex(c_double), target :: z3  ! OK
+complex(dt), target       :: z4  ! OK
+type(c_ptr) :: ptr
+
+ptr = c_loc(z1)
+ptr = c_loc(z2)
+ptr = c_loc(z3)
+ptr = c_loc(z4)
+end
Index: gcc/testsuite/gfortran.dg/interop_params.f03
===================================================================
--- gcc/testsuite/gfortran.dg/interop_params.f03	(Revision 141918)
+++ gcc/testsuite/gfortran.dg/interop_params.f03	(Arbeitskopie)
@@ -13,8 +13,8 @@ contains
     integer, value :: my_f90_int 
   end subroutine test_0
 
-  subroutine test_1(my_f90_real) bind(c) ! { dg-error "is for type INTEGER" } 
-    real(c_int), value :: my_f90_real 
+  subroutine test_1(my_f90_real) bind(c)
+    real(c_int), value :: my_f90_real    ! { dg-warning "is for type INTEGER" }
   end subroutine test_1
 
   subroutine test_2(my_type) bind(c) ! { dg-error "is not C interoperable" }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]