[gcc/devel/ranger] fortran] Fix PR 85781, ICE on valid
Aldy Hernandez
aldyh@gcc.gnu.org
Wed Jun 17 18:19:32 GMT 2020
https://gcc.gnu.org/g:86075aa5dd0b1ed3f6c9c67d0d3058c6c5c19d65
commit 86075aa5dd0b1ed3f6c9c67d0d3058c6c5c19d65
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon Jan 27 10:13:27 2020 +0100
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:
---
gcc/fortran/ChangeLog | 6 ++++
gcc/fortran/trans-expr.c | 8 +++--
gcc/testsuite/ChangeLog | 8 +++++
gcc/testsuite/gfortran.dg/bind_c_char_2.f90 | 50 ++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_3.f90 | 51 +++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_4.f90 | 21 ++++++++++++
gcc/testsuite/gfortran.dg/bind_c_char_5.f90 | 21 ++++++++++++
7 files changed, 163 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ceefdf8c03d..bfc3b224ecb 100644
--- 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 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/ChangeLog b/gcc/testsuite/ChangeLog
index f2af1ebac15..bcaca253aaf 100644
--- 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
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" }
More information about the Gcc-cvs
mailing list