The main purpose of this patch is to allow elements of assumed-shape
arrays (which are scalars) and assumed-rank arrays with C_LOC.
There are several other issues with the current C_LOC handling (and with
C_F_POINTER), but I want to fix the most important reject-valid issues
first as they block a project I am interested in.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
2012-08-14 Tobias Burnus <bur...@net-b.de>
PR fortran/50269
* interface.c (gfc_procedure_use): Alloc assumed-rank arrays
as argument to C_LOC.
* resolve.c (gfc_iso_c_func_interface): Allow elements of
assumed-shape/deferred-shape arrays with C_LOC.
2012-08-14 Tobias Burnus <bur...@net-b.de>
PR fortran/50269
* gfortran.dg/c_loc_tests_17.f90: New.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 482c294..4097ecc 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3151,6 +3151,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
/* TS 29113, C407b. */
if (a->expr && a->expr->expr_type == EXPR_VARIABLE
+ && sym->intmod_sym_id != ISOCBINDING_LOC
&& symbol_rank (a->expr->symtree->n.sym) == -1)
{
gfc_error ("Assumed-rank argument requires an explicit interface "
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c706b89..8aa8de8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2874,6 +2874,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
{
gfc_ref *ref;
bool seen_section;
+ gfc_array_spec *as = args->expr->symtree->n.sym->as;
/* Make sure we have either the target or pointer attribute. */
if (!arg_attr.target && !arg_attr.pointer)
@@ -2901,6 +2902,8 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
{
if (ref->type == REF_ARRAY)
{
+ as = ref->u.ar.as;
+
if (ref->u.ar.type == AR_SECTION)
seen_section = true;
@@ -2953,9 +2956,9 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
/* A non-allocatable target variable with C
interoperable type and type parameters must be
interoperable. */
- if (args_sym && args_sym->attr.dimension)
+ if (args_sym && args->expr->rank != 0)
{
- if (args_sym->as->type == AS_ASSUMED_SHAPE)
+ if (as->type == AS_ASSUMED_SHAPE)
{
gfc_error ("Assumed-shape array '%s' at %L "
"cannot be an argument to the "
@@ -2965,7 +2968,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
&(args->expr->where), sym->name);
retval = FAILURE;
}
- else if (args_sym->as->type == AS_DEFERRED)
+ else if (as->type == AS_DEFERRED)
{
gfc_error ("Deferred-shape array '%s' at %L "
"cannot be an argument to the "
--- /dev/null 2012-08-08 07:41:43.631684108 +0200
+++ gcc/gcc/testsuite/gfortran.dg/c_loc_tests_17.f90 2012-08-14 23:11:37.000000000 +0200
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! Check that C_LOC (assumed-rank) works (valid TS29113)
+! and that ! taking an element of an assumed-shape/deferred-shape
+! array works (valid since Fortran 2003)
+!
+
+integer, target :: a(5)
+a = [34, 7383, 378, 393, -3]
+call foo ([11,22,33], [-3,-5,-8,-33], a, [11,22,33])
+contains
+subroutine foo(x, y, z, val)
+ use iso_c_binding
+ integer :: val(:)
+ type(*), target :: x(..)
+ integer, target :: y(:)
+ integer, pointer, intent(in) :: z(:)
+ type(c_ptr) :: p
+ p = c_loc (x)
+ call check (p, val)
+ p = c_loc (y(1))
+ call check (p, y)
+ p = c_loc (z(2))
+ call check (p, z(2:))
+end subroutine foo
+
+subroutine check (p, val)
+ use iso_c_binding
+ type(c_ptr) :: p
+ integer :: val(:)
+ integer, pointer :: iptr(:)
+ call c_f_pointer (p, iptr, shape=shape(val))
+ if (any (iptr /= val)) call abort ()
+end subroutine check
+end
