re PR fortran/50269 (Wrongly rejects element of assumed-shape array in C_LOC)
authorTobias Burnus <burnus@net-b.de>
Thu, 4 Apr 2013 07:22:24 +0000 (09:22 +0200)
committerTobias Burnus <burnus@gcc.gnu.org>
Thu, 4 Apr 2013 07:22:24 +0000 (09:22 +0200)
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
gcc/fortran/check.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/c_loc_test_19.f90
gcc/testsuite/gfortran.dg/c_loc_test_21.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
gcc/testsuite/gfortran.dg/c_loc_tests_4.f03

index bf2a244dee7d149506edc10095224b8ef0e990d9..c42d02f9bd6ef6e86b093f6a620c3cbed007657c 100644 (file)
@@ -1,3 +1,10 @@
+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
        * 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,
index 99174bcc75b59feb45653a83b5967ecb06c64447..5df5d2f2518c7bf7e897d428fd884d9cc6f7cc15 100644 (file)
@@ -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;
 }
index dc0b74533f469c83b6418ad981ac470f4b60af0c..6596dce007c34e4666874b80d619973426d28592 100644 (file)
@@ -1,3 +1,13 @@
+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
index a667eaf52de4817c2ae42421d49ea2e1feb0ae36..ea62715f33f7162ac513fe31b0e9d7a737d1ffcb 100644 (file)
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_21.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_21.f90
new file mode 100644 (file)
index 0000000..a31ca03
--- /dev/null
@@ -0,0 +1,16 @@
+! { 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
index 21cbe0be7ec0ba4d12913fe7c7a094137862c800..21b8526c2ab8f2731ace61c5353545c4b477b855 100644 (file)
@@ -1,9 +1,9 @@
 ! { 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
index b8e6d849e67a6a3994d90c08db76e96206f64c0c..c00e5ed164009e3b0ff5d80c2ea0d600ba24635d 100644 (file)
@@ -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
index 2c074e874f0dec473f232accbfc61831109363c2..55e8d00fa9cba1260c01afcb41c3c2c17639d558 100644 (file)
@@ -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
index 1f28d3e0c0e64e8fa0170c8c78ee93c754c24edb..d45a89156fc79ec838f848c9ab8274f33e9e74c7 100644 (file)
@@ -1,5 +1,5 @@
 ! { 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