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.
@@ -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;
}
@@ -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
new file mode 100644
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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