diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 21 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03 | 21 |
4 files changed, 39 insertions, 15 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bc9738a..0c623dd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-01-09 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/38536 + * resolve.c (is_scalar_expr_ptr): For a substring reference, + use gfc_dep_compare_expr to compare start and end expession. + Add FIXME for using gfc_deb_compare_expr elsewhere. + 2011-01-09 Janus Weil <janus@gcc.gnu.org> PR fortran/46313 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fec84cc..b86c430 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2567,21 +2567,11 @@ is_scalar_expr_ptr (gfc_expr *expr) switch (ref->type) { case REF_SUBSTRING: - if (ref->u.ss.length != NULL - && ref->u.ss.length->length != NULL - && ref->u.ss.start - && ref->u.ss.start->expr_type == EXPR_CONSTANT - && ref->u.ss.end - && ref->u.ss.end->expr_type == EXPR_CONSTANT) - { - start = (int) mpz_get_si (ref->u.ss.start->value.integer); - end = (int) mpz_get_si (ref->u.ss.end->value.integer); - if (end - start + 1 != 1) - retval = FAILURE; - } - else - retval = FAILURE; + if (ref->u.ss.start == NULL || ref->u.ss.end == NULL + || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) != 0) + retval = FAILURE; break; + case REF_ARRAY: if (ref->u.ar.type == AR_ELEMENT) retval = SUCCESS; @@ -2610,7 +2600,8 @@ is_scalar_expr_ptr (gfc_expr *expr) { /* We have constant lower and upper bounds. If the difference between is 1, it can be considered a - scalar. */ + scalar. + FIXME: Use gfc_dep_compare_expr instead. */ start = (int) mpz_get_si (ref->u.ar.as->lower[0]->value.integer); end = (int) mpz_get_si diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 97d5ce4..82d316a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-01-09 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/38536 + * gfortran.dg/iso_c_binding_c_loc_char_1.f03: New test. + 2011-01-09 Janus Weil <janus@gcc.gnu.org> PR fortran/46313 diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03 new file mode 100644 index 0000000..14bc4a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03 @@ -0,0 +1,21 @@ +! { dg-do compile } +! PR 38536 - don't reject substring of length one +! Original test case by Scot Breitenfeld +SUBROUTINE test(buf, buf2, buf3, n) + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(INOUT), TARGET :: buf + INTEGER, INTENT(in) :: n + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(1:2), TARGET :: buf2 + CHARACTER(LEN=3), TARGET :: buf3 + TYPE(C_PTR) :: f_ptr + + f_ptr = C_LOC(buf(1:1)) ! Used to fail + ! Error: CHARACTER argument 'buf' to 'c_loc' + ! at (1) must have a length of 1 + f_ptr = C_LOC(buf2(1)(1:1)) ! PASSES + + f_ptr = C_LOC(buf(n:n)) + + f_ptr = C_LOC(buf3(3:)) +END SUBROUTINE test |