From 2ec855f1f74eb35dc8e2909b837ff7d8888d2220 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 22 Nov 2008 19:18:05 +0100 Subject: [PATCH] re PR fortran/38160 (C Binding: Kind parameter checking too strict and too late) 2008-11-22 Tobias Burnus 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 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. From-SVN: r142124 --- gcc/fortran/ChangeLog | 12 ++++++ gcc/fortran/decl.c | 39 +++++++------------ gcc/fortran/gfortran.h | 3 +- gcc/fortran/resolve.c | 5 +-- gcc/fortran/symbol.c | 3 +- gcc/fortran/trans-types.c | 14 ------- gcc/testsuite/ChangeLog | 7 ++++ gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 | 29 ++++++++++++++ gcc/testsuite/gfortran.dg/c_kind_tests_2.f03 | 6 +-- gcc/testsuite/gfortran.dg/interop_params.f03 | 4 +- 10 files changed, 70 insertions(+), 52 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f1ac3ed5588..46cec41972a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2008-11-12 Tobias Burnus + + 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 PR libfortran/37839 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index fe044c7c698..dabbafa68c6 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index ac68a52dd3d..d5d28f24fbc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 *); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e4766d6de56..0f0644f0d83 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index ac953bde6bb..4e81b89e2b0 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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) { diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index c4c83143777..de629646ec8 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -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) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 194a90c3d7b..3b5fae63cab 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2008-11-22 Tobias Burnus + + 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 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 index 00000000000..30534cca9a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03 index dcac65dec43..ced31a554ba 100644 --- a/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03 +++ b/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/interop_params.f03 b/gcc/testsuite/gfortran.dg/interop_params.f03 index 8163b4a5040..96c7d5cef16 100644 --- a/gcc/testsuite/gfortran.dg/interop_params.f03 +++ b/gcc/testsuite/gfortran.dg/interop_params.f03 @@ -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" }