Patchwork [Fortran] PR50269 - Add some checking fixes for C_LOC

login
register
mail settings
Submitter Tobias Burnus
Date April 2, 2013, 4:26 p.m.
Message ID <515B06CD.7060302@net-b.de>
Download mbox | patch
Permalink /patch/233095/
State New
Headers show

Comments

Tobias Burnus - April 2, 2013, 4:26 p.m.
This patch updates the C_LOC checking fixes for array. In particular:

Fortran 2003 allows:

"(1) have interoperable type and type parameters and be
     (a) a variable that has the TARGET attribute and is interoperable,
     (b) an allocated allocatable variable that has the TARGET attribute 
and is not an array of zero size, or"

For arrays: If the type/kind is okay, either it can be an allocatable 
array (i.e. contiguous) or interoperable (i.e. 
assumed-size/explicit-size array).


Fortran 2008 has:
"It shall either be a variable with interoperable type and kind type 
parameters, or be a scalar, nonpolymorphic variable ... If it is an 
array, it shall be contiguous ..."

Thus, it allows also other arrays types - and also array sections. (They 
must be noncontiguous but that that's in general not testable; for one 
of the examples, it would be testable but the gfc_simply_noncontiguous 
function does not yet exist.)

Build + regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Mikael Morin - April 3, 2013, 10:17 p.m.
Le 02/04/2013 18:26, Tobias Burnus a écrit :
> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
> index 99174bc..b0c831e 100644
> --- a/gcc/fortran/check.c
> +++ b/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_len is true, character with len > 1 are allowed (cf. Fortran
s/c_len/c_loc/ (or s/c_loc/c_len/ everywhere else).

> +   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)



> Build + regtested on x86-64-gnu-linux.
> OK for the trunk?
>
OK

Patch

2013-04-02  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-02  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.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 99174bc..b0c831e 100644
--- a/gcc/fortran/check.c
+++ b/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_len 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;
 }
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_19.f90
index a667eaf..ea62715 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_19.f90
+++ b/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
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
index 0000000..a31ca03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_21.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
index 21cbe0b..21b8526 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
index b8e6d84..c00e5ed 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
index 2c074e8..55e8d00 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
index 1f28d3e..d45a8915 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
@@ -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