Message ID | 5006D391.5000102@net-b.de |
---|---|
State | New |
Headers | show |
On 18/07/2012 17:17, Tobias Burnus wrote: > This patch was written on top of the big assumed-shape patch.* However, > it should also work by itself. > > Bootstrapped and regtested on x86-64-linux. > OK for the trunk? > > Tobias > > * http://gcc.gnu.org/ml/fortran/2012-07/msg00052.html > 2012-07-18 Tobias Burnus <burnus@net-b.de> > > * decl.c (gfc_verify_c_interop_param): Allow assumed-shape > with -std=f2008ts. > > 2012-07-18 Tobias Burnus <burnus@net-b.de> > > * gfortran.dg/bind_c_array_params_2.f90: New. > * gfortran.dg/bind_c_array_params.f03: Add -std=f2003 > and update dg-error. > > diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c > index 01693ad..4184608 100644 > --- a/gcc/fortran/decl.c > +++ b/gcc/fortran/decl.c > @@ -1092,29 +1096,15 @@ gfc_verify_c_interop_param (gfc_symbol *sym) > retval = FAILURE; > > /* Make sure that if it has the dimension attribute, that it is > - either assumed size or explicit shape. */ > - if (sym->as != NULL) > - { > - if (sym->as->type == AS_ASSUMED_SHAPE) > - { > - gfc_error ("Assumed-shape array '%s' at %L cannot be an " > - "argument to the procedure '%s' at %L because " > - "the procedure is BIND(C)", sym->name, > - &(sym->declared_at), sym->ns->proc_name->name, > - &(sym->ns->proc_name->declared_at)); > - retval = FAILURE; > - } > - > - if (sym->as->type == AS_DEFERRED) > - { > - gfc_error ("Deferred-shape array '%s' at %L cannot be an " > - "argument to the procedure '%s' at %L because " > - "the procedure is BIND(C)", sym->name, > - &(sym->declared_at), sym->ns->proc_name->name, > - &(sym->ns->proc_name->declared_at)); > - retval = FAILURE; > - } > - } > + either assumed size or explicit shape. Deferred shape is already > + covered by the pointer/allocatable attribute. */ Don't we need to fix the pointer/allocatable diagnostics as well then? > + if (sym->as != NULL && sym->as->type == AS_ASSUMED_SHAPE > + && gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array '%s' " > + "at %L as dummy argument to the BIND(C) " > + "procedure '%s' at %L", sym->name, > + &(sym->declared_at), sym->ns->proc_name->name, > + &(sym->ns->proc_name->declared_at)) == FAILURE) > + retval = FAILURE; > } > } >
On 07/20/2012 11:55 AM, Mikael Morin wrote: > On 18/07/2012 17:17, Tobias Burnus wrote: >> + either assumed size or explicit shape. Deferred shape is already >> + covered by the pointer/allocatable attribute. */ > Don't we need to fix the pointer/allocatable diagnostics as well then? Yes, but that requires additional changes in trans-expr.c, which I intended to handle later. In particular, for BIND(C) "character(len=*)" is allowed; it uses the array descriptor but may not be allocatable / a pointer. And for pointers/allocatables: With BIND(C), scalars are passed via the array descriptor, without not. As it started to get complicated, I didn't want to mangle that part with the assumed-rank patch. But if you prefer, I can now also lump all Bind(C) changes of TS29113 together into a big patch. Tobias
On 20/07/2012 12:09, Tobias Burnus wrote: > But if you prefer, I can now also lump all Bind(C) changes of TS29113 > together into a big patch. > No thanks. Patch is OK. Mikael
2012-07-18 Tobias Burnus <burnus@net-b.de> * decl.c (gfc_verify_c_interop_param): Allow assumed-shape with -std=f2008ts. 2012-07-18 Tobias Burnus <burnus@net-b.de> * gfortran.dg/bind_c_array_params_2.f90: New. * gfortran.dg/bind_c_array_params.f03: Add -std=f2003 and update dg-error. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 01693ad..4184608 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1092,29 +1096,15 @@ gfc_verify_c_interop_param (gfc_symbol *sym) retval = FAILURE; /* Make sure that if it has the dimension attribute, that it is - either assumed size or explicit shape. */ - if (sym->as != NULL) - { - if (sym->as->type == AS_ASSUMED_SHAPE) - { - gfc_error ("Assumed-shape array '%s' at %L cannot be an " - "argument to the procedure '%s' at %L because " - "the procedure is BIND(C)", sym->name, - &(sym->declared_at), sym->ns->proc_name->name, - &(sym->ns->proc_name->declared_at)); - retval = FAILURE; - } - - if (sym->as->type == AS_DEFERRED) - { - gfc_error ("Deferred-shape array '%s' at %L cannot be an " - "argument to the procedure '%s' at %L because " - "the procedure is BIND(C)", sym->name, - &(sym->declared_at), sym->ns->proc_name->name, - &(sym->ns->proc_name->declared_at)); - retval = FAILURE; - } - } + either assumed size or explicit shape. Deferred shape is already + covered by the pointer/allocatable attribute. */ + if (sym->as != NULL && sym->as->type == AS_ASSUMED_SHAPE + && gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array '%s' " + "at %L as dummy argument to the BIND(C) " + "procedure '%s' at %L", sym->name, + &(sym->declared_at), sym->ns->proc_name->name, + &(sym->ns->proc_name->declared_at)) == FAILURE) + retval = FAILURE; } } diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 index 6590db1..810f642 100644 --- a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 +++ b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 @@ -1,10 +1,11 @@ ! { dg-do compile } +! { dg-options "-std=f2003" } module bind_c_array_params use, intrinsic :: iso_c_binding implicit none contains - subroutine sub0(assumed_array) bind(c) ! { dg-error "cannot be an argument" } + subroutine sub0(assumed_array) bind(c) ! { dg-error "TS 29113: Assumed-shape array 'assumed_array' at .1. as dummy argument to the BIND.C. procedure 'sub0'" } integer(c_int), dimension(:) :: assumed_array end subroutine sub0 --- /dev/null 2012-07-18 07:03:52.759757921 +0200 +++ gcc/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 2012-07-18 00:14:13.000000000 +0200 @@ -0,0 +1,19 @@ +! { dg-do compile } +! { dg-options "-std=f2008ts -fdump-tree-original" } +! +! Check that assumed-shape variables are correctly passed to BIND(C) +! as defined in TS 29913 +! +interface + subroutine test (xx) bind(C, name="myBindC") + type(*), dimension(:,:) :: xx + end subroutine test +end interface + +integer :: aa(4,4) +call test(aa) +end + +! { dg-final { scan-tree-dump-times "test \\\(&parm\\." 1 "original" } } +! { dg-final { scan-assembler-times "myBindC" 1 } } +