re PR fortran/38536 (ICE with C_LOC in resolve.c due to not properly going through expr->ref)

2011-01-22  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-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/38536
	* gfortran.dg/c_loc_tests_16.f90:  New test.

From-SVN: r169130

4 files changed, 80 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f0562ac..e918ef5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2011-01-22  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-22  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/47399
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f2e7223..9f0d675 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2699,6 +2699,9 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
         }
       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)
             {
@@ -2709,6 +2712,45 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
               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)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d0a8f40..ce423e1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/38536
+	* gfortran.dg/c_loc_tests_16.f90:  New test.
+
 2011-01-22  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/47399
@@ -7,7 +12,7 @@
 
 	PR tree-optimization/47053
 	* g++.dg/pr47053.C: New test.
-	
+
 2011-01-21  Jason Merrill  <jason@redhat.com>
 
 	PR c++/47041
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
new file mode 100644
index 0000000..1c86a1f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
@@ -0,0 +1,25 @@
+! { 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