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  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/38536
	* gfortran.dg/iso_c_binding_c_loc_char_1.f03:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@168614 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bc9738a..0c623dd 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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