mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 04:40:27 +08:00
Code Issues Packages Projects Releases Wiki Activity

fortran] Fix PR 85781, ICE on valid

Browse Source 
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.
This commit is contained in:
Tobias Burnus 2020-01-27 10:13:27 +01:00
parent 40bf3f1fd0
commit 86075aa5dd
7 changed files with 163 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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.

8
gcc/fortran/trans-expr.c
View File

@ -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. */

8
gcc/testsuite/ChangeLog
View File

@ -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

50
gcc/testsuite/gfortran.dg/bind_c_char_2.f90 Normal file
View File

@ -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

51
gcc/testsuite/gfortran.dg/bind_c_char_3.f90 Normal file
View File

@ -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

21
gcc/testsuite/gfortran.dg/bind_c_char_4.f90 Normal file
View File

@ -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." }

21
gcc/testsuite/gfortran.dg/bind_c_char_5.f90 Normal file
View File

@ -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" }