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

[Tobias Burnus <burnus at net-b dot de>]

Mikael Morin wrote:
> gfc_free_charlen is not part of it ;-)
>   
That happens if one does a minor modification and forgets that one
applied another patch before re-diffing. I now attached only the actual
patch. Thanks for spotting it.

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)
@@ -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)
@@ -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 *);
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/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" }