Hi Thomas, hi all,
first, I have now attached a different fix for PR 85781 (= original
bug). Can you have a look?
I have the feeling (but didn't check) that your patch does not handle
the following variant of the test case: "print *, x(m:n)" (i.e. the
lower bound is not known at compile time).
I hope my patch covers all issues. – OK for the trunk?
Secondly:
On 1/21/20 7:32 PM, Thomas König wrote:
the attached patch fixes an ICE which could occur for empty
substrings (see test case).
I think one should rather fix the following issue.
I am not sure what you mean. Does that mean that fixing the following
issue will also fix PR 85781
I am no longer sure what I meant myself ;-)
I initially thought those are directly related – but they now look
related but independent bugs:
PR 85781 is about getting a non-ARRAY_TYPE (tree dump: "character") and
using it as ARRAY_TYPE (tree dump: "character[lb:ub]").
While PR93336 is about (1) using an ARRAY_TYPE when one should not. –
And, additionally, about missing diagnostic related to (2) bind(c) and
kind=4, (3) passing zero-length strings to non-zero-length dummy args,
(4) diagnostic about truncating too long strings (esp. if of
non-default, non-c_char kind).
Tobias
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/trans-expr.c b/gcc/fortran/trans-expr.c
index e1c0fb271de..5825a4b8ce3 100644
--- 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/gfortran.dg/bind_c_char_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_2.f90
new file mode 100644
index 00000000000..23a0cac2b4f
--- /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
index 00000000000..01113aad0c5
--- /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
index 00000000000..cce9270f1b6
--- /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
index 00000000000..9092dd58396
--- /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" }
