re PR fortran/50269 (Wrongly rejects element of assumed-shape array in C_LOC)

2013-04-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/50269
        * gcc/fortran/check.c (is_c_interoperable,
        gfc_check_c_loc): Correct c_loc array checking
        for Fortran 2003 and Fortran 2008.

2013-04-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/50269
        * gfortran.dg/c_loc_test_21.f90: New.
        * gfortran.dg/c_loc_test_19.f90: Update dg-error.
        * gfortran.dg/c_loc_tests_10.f03: Update dg-error.
        * gfortran.dg/c_loc_tests_11.f03: Update dg-error.
        * gfortran.dg/c_loc_tests_4.f03: Update dg-error.
        * gfortran.dg/c_loc_tests_16.f90:  Update dg-error.

From-SVN: r197468

gcc/fortran/ChangeLog

+2013-04-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50269
+	* gcc/fortran/check.c (is_c_interoperable,
+	gfc_check_c_loc): Correct c_loc array checking
+	for Fortran 2003 and Fortran 2008.
+
 2013-04-03  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/56284
@@ -282,7 +289,7 @@
 	* trans-array.c (structure_alloc_comps): Handle procedure-pointer
 	components with allocatable result.
 
-2012-02-21  Tobias Burnus  <burnus@net-b.de>
+2013-02-21  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/56416
 	* gfortran.texi (Part II: Language Reference, Extensions,

gcc/fortran/check.c

@@ -3649,11 +3649,12 @@ gfc_check_sizeof (gfc_expr *arg)
 /* Check whether an expression is interoperable.  When returning false,
    msg is set to a string telling why the expression is not interoperable,
    otherwise, it is set to NULL.  The msg string can be used in diagnostics.
-   If all_len_okay is true, all length-type parameters (for character) are
-   allowed.  Required for C_LOC (cf. Fortran 2003corr5 or Fortran 2008).  */
+   If c_loc is true, character with len > 1 are allowed (cf. Fortran
+   2003corr5); additionally, assumed-shape/assumed-rank/deferred-shape
+   arrays are permitted.  */
 
 static bool
-is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay)
+is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc)
 {
   *msg = NULL;
 
@@ -3706,7 +3707,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay)
 	&& gfc_simplify_expr (expr, 0) == FAILURE)
       gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed");
 
-    if (!all_len_okay && expr->ts.u.cl
+    if (!c_loc && expr->ts.u.cl
 	&& (!expr->ts.u.cl->length
 	    || expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
 	    || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0))
@@ -3726,7 +3727,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay)
       return false;
     }
 
-  if (expr->rank > 0 && expr->expr_type != EXPR_ARRAY)
+  if (!c_loc && expr->rank > 0 && expr->expr_type != EXPR_ARRAY)
     {
       gfc_array_ref *ar = gfc_find_array_ref (expr);
       if (ar->type != AR_FULL)
@@ -4043,6 +4044,22 @@ gfc_check_c_loc (gfc_expr *x)
 			 " argument to C_LOC: %s", &x->where, msg) == FAILURE)
 	  return FAILURE;
     }
+  else if (x->rank > 0 && gfc_notification_std (GFC_STD_F2008))
+    {
+      gfc_array_ref *ar = gfc_find_array_ref (x);
+
+      if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE
+	  && !attr.allocatable
+	  && gfc_notify_std (GFC_STD_F2008, "Array of interoperable type at %L "
+			     "to C_LOC which is nonallocatable and neither "
+			     "assumed size nor explicit size", &x->where)
+	     == FAILURE)
+	return FAILURE;
+      else if (ar->type != AR_FULL
+	       && gfc_notify_std (GFC_STD_F2008, "Array section at %L "
+				  "to C_LOC", &x->where) == FAILURE)
+	return FAILURE;
+    }
 
   return SUCCESS;
 }

gcc/testsuite/ChangeLog

+2013-04-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50269
+	* gfortran.dg/c_loc_test_21.f90: New.
+	* gfortran.dg/c_loc_test_19.f90: Update dg-error.
+	* gfortran.dg/c_loc_tests_10.f03: Update dg-error.
+	* gfortran.dg/c_loc_tests_11.f03: Update dg-error.
+	* gfortran.dg/c_loc_tests_4.f03: Update dg-error.
+	* gfortran.dg/c_loc_tests_16.f90:  Update dg-error.
+
 2013-04-03  Jeff Law  <law@redhat.com>
 
 	PR tree-optimization/56799

gcc/testsuite/gfortran.dg/c_loc_test_19.f90

@@ -12,6 +12,6 @@ Contains
      Real( c_double ), Dimension( : ), Target :: aa
      Type( c_ptr ), Pointer :: b
      b = c_loc( aa( 1 ) )  ! was rejected before.
-     b = c_loc( aa ) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
+     b = c_loc( aa ) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" }
    End Subroutine test
 End Program gf

gcc/testsuite/gfortran.dg/c_loc_test_21.f90

+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+subroutine foo(a,b,c,d)
+   use iso_c_binding, only: c_loc, c_ptr
+   implicit none
+   real, intent(in), target :: a(:)
+   real, intent(in), target :: b(5)
+   real, intent(in), target :: c(*)
+   real, intent(in), target, allocatable :: d(:)
+   type(c_ptr) :: ptr
+   ptr = C_LOC(b)
+   ptr = C_LOC(c)
+   ptr = C_LOC(d)
+   ptr = C_LOC(a) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" }
+end subroutine foo

gcc/testsuite/gfortran.dg/c_loc_tests_10.f03

 ! { dg-do compile }
-! { dg-options "-std=f2008" }
+! { dg-options "-std=f2003" }
 subroutine aaa(in)
   use iso_c_binding
   implicit none
   integer(KIND=C_int), DIMENSION(:), TARGET  :: in
   type(c_ptr) :: cptr
-  cptr = c_loc(in) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC" }
+  cptr = c_loc(in) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" }
 end subroutine aaa

gcc/testsuite/gfortran.dg/c_loc_tests_11.f03

@@ -31,9 +31,9 @@ contains
     integer(c_int), intent(in) :: handle
     
     if (.true.) then   ! The ultimate component is an allocatable target 
-      get_double_vector_address = c_loc(dbv_pool(handle)%v)  ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
+      get_double_vector_address = c_loc(dbv_pool(handle)%v)  ! OK: Interop type and allocatable
     else
-      get_double_vector_address = c_loc(vv)  ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
+      get_double_vector_address = c_loc(vv)  ! OK: Interop type and allocatable
     endif
     
   end function get_double_vector_address

gcc/testsuite/gfortran.dg/c_loc_tests_16.f90

@@ -19,7 +19,7 @@
   type(C_PTR) :: p
 
   p = c_loc(tt%t%i(1))
-  p = c_loc(n(1:2))  ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only whole-arrays are interoperable" }
-  p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only whole-arrays are interoperable" }
+  p = c_loc(n(1:2))  ! OK: interop type + contiguous
+  p = c_loc(ttt%t(5,1:2)%i(1)) ! FIXME: Noncontiguous (invalid) - compile-time testable
   p = c_loc(x[1]) ! { dg-error "shall not be coindexed" }
   end

gcc/testsuite/gfortran.dg/c_loc_tests_4.f03

 ! { dg-do compile }
-! { dg-options "-std=f2008" }
+! { dg-options "-std=f2003" }
 !
 module c_loc_tests_4
   use, intrinsic :: iso_c_binding
@@ -12,6 +12,6 @@ contains
     type(c_ptr) :: my_c_ptr
 
     my_array_ptr => my_array
-    my_c_ptr = c_loc(my_array_ptr) ! { dg-error "Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
+    my_c_ptr = c_loc(my_array_ptr) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" }
   end subroutine sub0
 end module c_loc_tests_4