fortran] Fix PR 85781, ICE on valid

        PR fortran/85781
        * trans-expr.c (gfc_conv_substring): Handle non-ARRAY_TYPE strings
        of Bind(C) procedures.

        PR fortran/85781
        * gfortran.dg/bind_c_char_2.f90: New.
        * gfortran.dg/bind_c_char_3.f90: New.
        * gfortran.dg/bind_c_char_4.f90: New.
        * gfortran.dg/bind_c_char_5.f90: New.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ceefdf8c03ddd97c76bda6e700fa49957a1143d8..bfc3b224ecb2c06829dfba7425ebabd4b6a5d718 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2020-01-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/85781
+       * trans-expr.c (gfc_conv_substring): Handle non-ARRAY_TYPE strings
+       of Bind(C) procedures.
+
 2020-01-22  Jakub Jelinek  <jakub@redhat.com>
 
        * parse.c (parse_omp_structured_block): Handle ST_OMP_TARGET_PARALLEL.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e1c0fb271debcdb0a4ee78905480866c28df3a78..5825a4b8ce3ca2eb3c8e63561be9af518f5d0411 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2334,8 +2334,12 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
       else
        tmp = build_fold_indirect_ref_loc (input_location,
                                       se->expr);
-      tmp = gfc_build_array_ref (tmp, start.expr, NULL);
-      se->expr = gfc_build_addr_expr (type, tmp);
+      /* For BIND(C), a BT_CHARACTER is not an ARRAY_TYPE.  */
+      if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
+       {
+         tmp = gfc_build_array_ref (tmp, start.expr, NULL);
+         se->expr = gfc_build_addr_expr (type, tmp);
+       }
     }
 
   /* Length = end + 1 - start.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f2af1ebac153f0e5391901aafa11fd776ae6dac4..bcaca253aafe8a9b6121de30da07425a45b749bd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2020-01-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/85781
+       * gfortran.dg/bind_c_char_2.f90: New.
+       * gfortran.dg/bind_c_char_3.f90: New.
+       * gfortran.dg/bind_c_char_4.f90: New.
+       * gfortran.dg/bind_c_char_5.f90: New.
+
 2020-01-26  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        * gcc.target/i386/pr91298-1.c: xfail on Solaris/x86 with native

diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_2.f90
new file mode 100644 (file)
index 0000000..23a0cac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_2.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+!
+! PR fortran/85781
+!
+! Co-contributed by G. Steinmetz 
+
+  use iso_c_binding, only: c_char
+  call s(c_char_'x', 1, 1)
+  call s(c_char_'x', 1, 0)
+  call s(c_char_'x', 0, -2)
+contains
+  subroutine s(x,m,n) bind(c)
+    use iso_c_binding, only: c_char
+    character(kind=c_char), value :: x
+    call foo(x(m:n), m, n)
+    if (n < m) then
+      if (len(x(m:n)) /= 0) stop 1
+      if (x(m:n) /= "") stop 2
+    else if (n == 1) then
+      if (len(x(m:n)) /= 1) stop 1
+      if (x(m:n) /= "x") stop 2
+    else
+      stop 14
+    end if
+    call foo(x(1:1), 1, 1)
+    call foo(x(1:0), 1, 0)
+    call foo(x(2:1), 2, 1)
+    call foo(x(0:-4), 0, -4)
+
+    call foo(x(1:), 1, 1)
+    call foo(x(2:), 2, 1)
+    call foo(x(:1), 1, 1)
+    call foo(x(:0), 1, 0)
+
+    if (n == 1) call foo(x(m:), m, n)
+    if (m == 1) call foo(x(:n), m, n)
+  end
+  subroutine foo(str, m, n)
+    character(len=*) :: str
+    if (n < m) then
+      if (len(str) /= 0) stop 11
+      if (str /= "") stop 12
+    else if (n == 1) then
+      if (len(str) /= 1) stop 13
+      if (str /= "x") stop 14
+    else
+      stop 14
+    end if
+  end
+end

diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_3.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_3.f90
new file mode 100644 (file)
index 0000000..01113aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_3.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=all" }
+!
+! PR fortran/85781
+!
+! Co-contributed by G. Steinmetz 
+
+  use iso_c_binding, only: c_char
+  call s(c_char_'x', 1, 1)
+  call s(c_char_'x', 1, 0)
+  call s(c_char_'x', 0, -2)
+contains
+  subroutine s(x,m,n) bind(c)
+    use iso_c_binding, only: c_char
+    character(kind=c_char), value :: x
+    call foo(x(m:n), m, n)
+    if (n < m) then
+      if (len(x(m:n)) /= 0) stop 1
+      if (x(m:n) /= "") stop 2
+    else if (n == 1) then
+      if (len(x(m:n)) /= 1) stop 1
+      if (x(m:n) /= "x") stop 2
+    else
+      stop 14
+    end if
+    call foo(x(1:1), 1, 1)
+    call foo(x(1:0), 1, 0)
+    call foo(x(2:1), 2, 1)
+    call foo(x(0:-4), 0, -4)
+
+    call foo(x(1:), 1, 1)
+    call foo(x(2:), 2, 1)
+    call foo(x(:1), 1, 1)
+    call foo(x(:0), 1, 0)
+
+    if (n == 1) call foo(x(m:), m, n)
+    if (m == 1) call foo(x(:n), m, n)
+  end
+  subroutine foo(str, m, n)
+    character(len=*) :: str
+    if (n < m) then
+      if (len(str) /= 0) stop 11
+      if (str /= "") stop 12
+    else if (n == 1) then
+      if (len(str) /= 1) stop 13
+      if (str /= "x") stop 14
+    else
+      stop 14
+    end if
+  end
+end

diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_4.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_4.f90
new file mode 100644 (file)
index 0000000..cce9270
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_4.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=all" }
+! { dg-shouldfail "Substring out of bounds" }
+!
+! PR fortran/85781
+!
+! Co-contributed by G. Steinmetz 
+
+  use iso_c_binding, only: c_char
+  call s(c_char_'x', 1, 2)
+contains
+  subroutine s(x,m,n) bind(c)
+    use iso_c_binding, only: c_char
+    character(kind=c_char), value :: x
+    call foo(x(m:n), m, n)
+  end
+  subroutine foo(str, m, n)
+    character(len=*) :: str
+  end
+end
+! { dg-output "Fortran runtime error: Substring out of bounds: upper bound .2. of 'x' exceeds string length .1." }

diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_5.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_5.f90
new file mode 100644 (file)
index 0000000..9092dd5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_5.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=all" }
+! { dg-shouldfail "Substring out of bounds" }
+!
+! PR fortran/85781
+!
+! Co-contributed by G. Steinmetz 
+
+  use iso_c_binding, only: c_char
+  call s(c_char_'x', -2, -2)
+contains
+  subroutine s(x,m,n) bind(c)
+    use iso_c_binding, only: c_char
+    character(kind=c_char), value :: x
+    call foo(x(m:), m, n)
+  end
+  subroutine foo(str, m, n)
+    character(len=*) :: str
+  end
+end
+! { dg-output "Fortran runtime error: Substring out of bounds: lower bound .-2. of 'x' is less than one" }