Commit 6082753e by Tobias Burnus Committed by Tobias Burnus

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
parent b4019227
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,
......
......@@ -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;
}
......
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
......
......@@ -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
! { 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
! { 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
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment