Hello,
Le 23/03/2013 10:59, Tobias Burnus a écrit :
> Dear all,
>
> initially, I only wanted to allow assumed-rank arrays with C_LOC, even if I
> played with the idea to cleanup the intrinsic handling of the ISO_C_Binding
> module for quite some time. But Mikael rejected a hacky version.
>
Did I? Never mind, the rejection proves fruitful in the end. :-)
>
> The main change of this patch is to move all the special handling of the
> intrinsics from symbol.c to the normal intrinsics code in intrinsic.{c,h},
> check.c, iresolve.c and trans-intrinsics.c. That also implied to do some
> larger changes to module.c. Additionally, I rewrote all the constraint checks
> from scratch, based on the Fortran 2003, 2008 and TS29113 standards - and
> fixed the fallout. Finally, I looked through the bugreports mentioning those
> intrinsics - and fixed some remaing issues (some were already fixed, either
> by this patch or since at least GCC 4.6).
>
> 2013-03-22 Tobias Burnus <bur...@net-b.de>
>
> PR fortran/38536
> PR fortran/38813
> PR fortran/38894
> PR fortran/39288
> PR fortran/40963
> PR fortran/45824
> PR fortran/47023
> PR fortran/49023
> PR fortran/50269
> PR fortran/50612
> PR fortran/52426
> PR fortran/54263
> PR fortran/55343
> PR fortran/55444
> PR fortran/56079
> PR fortran/56378
Really impressive. You can also add PR 55574 to the list (test case
attached).
There is one thing in the patch I'm uncomfortable with, namely:
> @@ -4192,7 +4245,11 @@ gfc_intrinsic_sub_interface (gfc_code *c, int
error_flag)
>
> name = c->symtree->n.sym->name;
>
> - isym = gfc_find_subroutine (name);
> + if (c->symtree->n.sym->intmod_sym_id)
> + isym = gfc_intrinsic_subroutine_by_id ((gfc_isym_id)
> + c->symtree->n.sym->intmod_sym_id);
Err... an iso_c_binding_symbol id is a different thing from a
gfc_isym_id id; isn't it?
After investigating further, it seems that create_intrinsic_function
sets the intmod_sym_id field to the gfc_isym_id id (even without your
patch).
This is confusing because the non-procedure symbols use as intmod_sym_id
a ISOCBINDING_* id, whereas procedures use a GFC_ISYM_* id.
I don't know how it ends up working, but I suggest the following change:
- store the ISOCBINDING_* id in intmod_sym_id
- retrieve the corresponding GFC_ISYM_* when needed (like above) using
c_interop_kinds_table[...->intmod_sym_id].value
By the way, create_intrinsic_function could certainly be simplified if
it was called from generate_isocbinding_symbol.
Otherwise, looks good. The usual nits below.
Mikael
> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
> index 0e71b95..28172fc 100644
> --- a/gcc/fortran/check.c
> +++ b/gcc/fortran/check.c
> @@ -693,12 +693,15 @@ gfc_var_strlen (const gfc_expr *a)
> {
> long start_a, end_a;
>
> + if (!ra->u.ss.start || !ra->u.ss.end)
> + return -1;
> +
This is a bit conservative (though not wrong); ra->u.ss.start == NULL at
least doesn't prevent string length evaluation.
> @@ -3621,17 +3624,389 @@ gfc_check_sizeof (gfc_expr *arg)
> }
>
>
> +/* Check whether an expression is interoperable. If all_len_okay is true,
> + all length-type parameters (for character) are allowed. Required for
> + C_LOC (cf. Fortran 2003corr5 or Fortran 2008). */
Could you add a comment about MSG?
Something like:
"when returning false, MSG is set to a string telling why the expression
is not interoperable, which can be used in diagnostics"
I think full sentences should be used for MSG, to avoid getting
confusing messages like the following (and to help translation):
"'foo' argument of 'bar' intrinsic at (1) must be an interoperable data
entity: deferred-length string"
thus:
"expression shall not be a deferred-length string"
instead of
"deferred-length string"
same for "Extension to use non-C_Bool-kind LOGICAL", "Extension:
Non-C_CHAR-kind CHARACTER"
[...]
> +gfc_try
> +gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2)
> +{
> + if (c_ptr_1->ts.type != BT_DERIVED
> + || (c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR
> + && c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_FUNPTR))
You should also check ...->from_intmod; just in case there is a vicious
user using a symbol (from a non-iso_c_binding intrinsic module) with the
same id as C_FUN/C_FUNPTR. ;-)
There are several instances of this with c_associated, c_f_pointer, etc.
> diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
> index 1b38555..8a92386 100644
> --- a/gcc/fortran/module.c
> +++ b/gcc/fortran/module.c
> @@ -5695,20 +5767,60 @@ import_iso_c_binding_module (void)
> {
> #define NAMED_FUNCTION(a,b,c,d) \
> case a: \
> + if (a == ISOCBINDING_LOC) \
> + create_intrinsic_function (u->local_name[0] \
> + ? u->local_name : u->use_name, \
> + (gfc_isym_id) c, \
> + iso_c_module_name, \
> + INTMOD_ISO_C_BINDING, false, \
> + c_ptr->n.sym); \
> + else if (a == ISOCBINDING_FUNLOC) \
> + create_intrinsic_function (u->local_name[0] \
> + ? u->local_name : u->use_name, \
> + (gfc_isym_id) c, \
> + iso_c_module_name, \
> + INTMOD_ISO_C_BINDING, false, \
> + c_funptr->n.sym); \
> + else \
> + create_intrinsic_function (u->local_name[0] \
> + ? u->local_name : u->use_name, \
> + (gfc_isym_id) c, \
> + iso_c_module_name, \
> + INTMOD_ISO_C_BINDING,
> false, NULL); \
> + break;
Could you simplify it a bit like this:
if (a == ISOCBINDING_LOC)
return_type = c_ptr->n.sym;
else if (a == ISOCBINDING_FUNLOC)
return_type = c_funptr->n.sym;
else
return_type = NULL;
create_intrinsic_function (..., return_type);
> default:
> - generate_isocbinding_symbol (iso_c_module_name,
> - (iso_c_binding_symbol) i,
> - u->local_name[0] ? u->local_name
> - : u->use_name);
> + if (i == ISOCBINDING_NULL_PTR)
> + generate_isocbinding_symbol (iso_c_module_name,
> + (iso_c_binding_symbol) i,
> + u->local_name[0]
> + ? u->local_name : u->use_name,
> + c_ptr, false);
> + else if (i == ISOCBINDING_NULL_FUNPTR)
> + generate_isocbinding_symbol (iso_c_module_name,
> + (iso_c_binding_symbol) i,
> + u->local_name[0]
> + ? u->local_name : u->use_name,
> + c_funptr, false);
> + else
> + generate_isocbinding_symbol (iso_c_module_name,
> + (iso_c_binding_symbol) i,
> + u->local_name[0]
> + ? u->local_name : u->use_name,
> + NULL, false);
Ditto here...
> @@ -5754,16 +5863,47 @@ import_iso_c_binding_module (void)
> {
> #define NAMED_FUNCTION(a,b,c,d) \
> case a: \
> + if (a == ISOCBINDING_LOC) \
> + create_intrinsic_function (b, (gfc_isym_id) c, \
> + iso_c_module_name, \
> + INTMOD_ISO_C_BINDING, false, \
> + c_ptr->n.sym); \
> + else if (a == ISOCBINDING_FUNLOC) \
> + create_intrinsic_function (b, (gfc_isym_id) c, \
> + iso_c_module_name, \
> + INTMOD_ISO_C_BINDING, false, \
> + c_funptr->n.sym); \
> + else \
> + create_intrinsic_function (b, (gfc_isym_id) c, \
> + iso_c_module_name, \
> + INTMOD_ISO_C_BINDING, false, \
> + NULL); \
> + break;
...and here...
> default:
> - generate_isocbinding_symbol (iso_c_module_name,
> - (iso_c_binding_symbol) i, NULL);
> + if (i == ISOCBINDING_NULL_PTR)
> + generate_isocbinding_symbol (iso_c_module_name,
> + (iso_c_binding_symbol) i, NULL,
> + c_ptr, false);
> + else if (i == ISOCBINDING_NULL_FUNPTR)
> + generate_isocbinding_symbol (iso_c_module_name,
> + (iso_c_binding_symbol) i, NULL,
> + c_funptr, false);
> + else
> + generate_isocbinding_symbol (iso_c_module_name,
> + (iso_c_binding_symbol) i, NULL,
> + NULL, false);
... and here.
> diff --git a/gcc/testsuite/gfortran.dg/blockdata_7.f90
> b/gcc/testsuite/gfortran.dg/blockdata_7.f90
> new file mode 100644
> index 0000000..16329c3
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/blockdata_7.f90
> @@ -0,0 +1,16 @@
> +! { dg-compile }
dg-do compile
> diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
> b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
> new file mode 100644
> index 0000000..19393c8
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
> @@ -0,0 +1,43 @@
> +! { dg-compile }
dg-do compile
! { dg-do compile }
!
! PR fortran/55574
! The following code used to be accepted because C_LOC pulls in C_PTR
! implicitly.
!
! Contributed by Valery Weber <valerywe...@hotmail.com>
!
program aaaa
use iso_c_binding, only : c_loc
integer, target :: i
type(C_PTR) :: f_ptr ! { dg-error "being used before it is defined" }
f_ptr=c_loc(i) ! { dg-error "Can't convert" }
end program aaaa
