From 6082753edc5406f746a196b8bb201c323fea2d8e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 4 Apr 2013 09:22:24 +0200 Subject: [PATCH] re PR fortran/50269 (Wrongly rejects element of assumed-shape array in C_LOC) 2013-04-04 Tobias Burnus 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 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 | 9 ++++++- gcc/fortran/check.c | 27 ++++++++++++++++---- gcc/testsuite/ChangeLog | 10 ++++++++ gcc/testsuite/gfortran.dg/c_loc_test_19.f90 | 2 +- gcc/testsuite/gfortran.dg/c_loc_test_21.f90 | 16 ++++++++++++ gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 | 4 +-- gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 | 4 +-- gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 | 4 +-- gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 | 4 +-- 9 files changed, 65 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_loc_test_21.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bf2a244dee7..c42d02f9bd6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-04-04 Tobias Burnus + + 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 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 +2013-02-21 Tobias Burnus PR fortran/56416 * gfortran.texi (Part II: Language Reference, Extensions, diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 99174bcc75b..5df5d2f2518 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_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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dc0b74533f4..6596dce007c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2013-04-04 Tobias Burnus + + 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 PR tree-optimization/56799 diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 index a667eaf52de..ea62715f33f 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 00000000000..a31ca034fbb --- /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 21cbe0be7ec..21b8526c2ab 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 b8e6d849e67..c00e5ed1640 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 2c074e874f0..55e8d00fa9c 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 1f28d3e0c0e..d45a89156fc 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 -- 2.30.2