From 86075aa5dd0b1ed3f6c9c67d0d3058c6c5c19d65 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 27 Jan 2020 10:13:27 +0100 Subject: [PATCH] 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. --- 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(-) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_char_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/bind_c_char_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/bind_c_char_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/bind_c_char_5.f90 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 + + PR fortran/85781 + * trans-expr.c (gfc_conv_substring): Handle non-ARRAY_TYPE strings + of Bind(C) procedures. + 2020-01-22 Jakub Jelinek * 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 + + 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 * 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" } -- 2.30.2