re PR fortran/38536 (ICE with C_LOC in resolve.c due to not properly going through...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f0562ac..e918ef5 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
index 0000000..1c86a1f
--- /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