From patchwork Tue Aug 14 22:09:02 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Fortran] PR50269 - C_LOC fixes Date: Tue, 14 Aug 2012 12:09:02 -0000 From: Tobias Burnus X-Patchwork-Id: 177465 Message-Id: <502ACC7E.1060304@net-b.de> To: gcc patches , gfortran 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 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 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