From patchwork Sat Jan 15 22:45:21 2011
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [fortran] Fix PR 38536
Date: Sat, 15 Jan 2011 12:45:21 -0000
From: Thomas Koenig <tkoenig@netcologne.de>
X-Patchwork-Id: 79070
Message-Id: <4D322381.5050000@netcologne.de>
To: Tobias Burnus <burnus@net-b.de>
Cc: "fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
 gcc-patches <gcc-patches@gcc.gnu.org>

Hi Tobias,

here is an update of the patch.  This one just warns about array
sections if they are followed by component references.

Against my earlier patch, this also catches cases like
c_loc(ttt%t(5,1:2)%i(1)).

Regression-tested.  OK for trunk?

	Thomas

2011-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/38536
	* resolve.c (gfc_iso_c_func_interface):  For C_LOC,
	check for array sections followed by component references
	which are illegal.  Also check for coindexed arguments.

2011-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/38536
	* gfortran.dg/c_loc_tests_16.f90:  New test.
! { dg-do compile }
! { dg-options "-fcoarray=single" }
! PR 38536 - array sections as arguments to c_loc are illegal.
  use iso_c_binding
  type, bind(c) :: t1
     integer(c_int) :: i(5)
  end type t1
  type, bind(c):: t2
     type(t1) :: t(5)
  end type t2
  type, bind(c) :: t3
     type(t1) :: t(5,5)
  end type t3

  type(t2), target :: tt
  type(t3), target :: ttt
  integer(c_int), target :: n(3)
  integer(c_int), target :: x[*]
  type(C_PTR) :: p

  p = c_loc(tt%t%i(1))  ! { dg-error "Array section not permitted" }
  p = c_loc(n(1:2))  ! { dg-warning "Array section" }
  p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "Array section not permitted" }
  p = c_loc(x[1]) ! { dg-error "Coindexed argument not permitted" }
  end


Index: resolve.c
===================================================================
--- resolve.c	(Revision 168614)
+++ resolve.c	(Arbeitskopie)
@@ -2709,6 +2709,9 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_act
         }
       else if (sym->intmod_sym_id == ISOCBINDING_LOC)
         {
+	  gfc_ref *ref;
+	  bool seen_section;
+
           /* Make sure we have either the target or pointer attribute.  */
 	  if (!arg_attr.target && !arg_attr.pointer)
             {
@@ -2719,6 +2722,45 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_act
               retval = FAILURE;
             }
 
+	  if (gfc_is_coindexed (args->expr))
+	    {
+	      gfc_error_now ("Coindexed argument not permitted"
+			     " in '%s' call at %L", name,
+			     &(args->expr->where));
+	      retval = FAILURE;
+	    }
+
+	  /* Follow references to make sure there are no array
+	     sections.  */
+	  seen_section = false;
+
+	  for (ref=args->expr->ref; ref; ref = ref->next)
+	    {
+	      if (ref->type == REF_ARRAY)
+		{
+		  if (ref->u.ar.type == AR_SECTION)
+		    seen_section = true;
+
+		  if (ref->u.ar.type != AR_ELEMENT)
+		    {
+		      gfc_ref *r;
+		      for (r = ref->next; r; r=r->next)
+			if (r->type == REF_COMPONENT)
+			  {
+			    gfc_error_now ("Array section not permitted"
+					   " in '%s' call at %L", name,
+					   &(args->expr->where));
+			    retval = FAILURE;
+			    break;
+			  }
+		    }
+		}
+	    }
+
+	  if (seen_section && retval == SUCCESS)
+	    gfc_warning ("Array section in '%s' call at %L", name,
+			 &(args->expr->where));
+			 
           /* See if we have interoperable type and type param.  */
           if (verify_c_interop (arg_ts) == SUCCESS
               || gfc_check_any_c_kind (arg_ts) == SUCCESS)