procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/38160 (C Binding: Kind parameter checking too strict and too late)

Browse source 
2008-11-22  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  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.

From-SVN: r142124
This commit is contained in:
Tobias Burnus 2008-11-22 19:18:05 +01:00 • committed by Tobias Burnus
parent 9d50ba211c
commit 2ec855f1f7
10 changed files with 70 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View 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

39
gcc/fortran/decl.c
View 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)

3
gcc/fortran/gfortran.h
View 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 *);

5
gcc/fortran/resolve.c
View 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)

3
gcc/fortran/symbol.c
View 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)
{

14
gcc/fortran/trans-types.c
View 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)
{

7
gcc/testsuite/ChangeLog
View 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

29
gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 Normal file
View file

@ -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

6
gcc/testsuite/gfortran.dg/c_kind_tests_2.f03
View 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

4
gcc/testsuite/gfortran.dg/interop_params.f03
View 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" }