diff mbox

[Fortran] PR50269 - C_LOC fixes

Message ID 502ACC7E.1060304@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Aug. 14, 2012, 10:09 p.m. UTC 
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
diff mbox

Patch

2012-08-14  Tobias Burnus  <burnus@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  <burnus@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