OSDN Git Service

2008-11-22 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 22 Nov 2008 18:18:05 +0000 (18:18 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 22 Nov 2008 18:18:05 +0000 (18:18 +0000)
        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-22  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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@142124 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/gfortran.h
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/fortran/trans-types.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/c_kind_tests_2.f03
gcc/testsuite/gfortran.dg/interop_params.f03

index f1ac3ed..46cec41 100644 (file)
@@ -1,3 +1,15 @@
+2008-11-12  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-22  Jakub Jelinek  <jakub@redhat.com>
 
        PR libfortran/37839
index fe044c7..dabbafa 100644 (file)
@@ -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_error_now ("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 *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, 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, 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), 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 ac68a52..d5d28f2 100644 (file)
@@ -2215,7 +2215,6 @@ arith gfc_check_integer_range (mpz_t p, int kind);
 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 *, 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 *, 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 e4766d6..0f0644f 100644 (file)
@@ -2073,10 +2073,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
             }
 
           /* 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 ac953bd..4e81b89 100644 (file)
@@ -3395,8 +3395,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), curr_comp->name,
-                                           &(curr_comp->loc));
+         is_c_interop = verify_c_interop (&(curr_comp->ts));
          
          if (is_c_interop != SUCCESS)
            {
index c4c8314..de62964 100644 (file)
@@ -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 194a90c..3b5fae6 100644 (file)
@@ -1,3 +1,10 @@
+2008-11-22  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.
+
 2008-11-22  Uros Bizjak  <ubizjak@gmail.com>
 
        PR target/38222
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_18.f90
new file mode 100644 (file)
index 0000000..30534cc
--- /dev/null
@@ -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-error "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-error "C kind type parameter is for type INTEGER" }
+complex(it), target       :: z2  ! { dg-error "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 dcac65d..ced31a5 100644 (file)
@@ -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(myF), bind(c) :: myCInt       ! { dg-error "is for type REAL" }
   integer(c_double), bind(c) :: myCInt2 ! { dg-error "is for type REAL" }
 
   integer, parameter :: myI = c_int
-  real(myI) :: myReal
+  real(myI) :: myReal             ! { dg-error "is for type INTEGER" }
   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(4), bind(c) :: myFloat     ! { dg-warning "may not be a C interoperable" }
 end module c_kind_tests_2
index 8163b4a..96c7d5c 100644 (file)
@@ -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-error "is for type INTEGER" }
   end subroutine test_1
 
   subroutine test_2(my_type) bind(c) ! { dg-error "is not C interoperable" }