From 643d443665ec68270af4c950fed4cdc1adad5154 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 11 Oct 2019 13:41:13 +0000 Subject: [PATCH] Fortran] PR 92050 - fix ICE with -fcheck=all gcc/fortran/ PR fortran/92050 * trans-expr.c (gfc_conv_procedure_call): Handle code generated by -fcheck=all. gcc/testsuite/ PR fortran/92050 * gfortran.dg/pr92050.f90: New. From-SVN: r276885 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-expr.c | 7 +++- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/pr92050.f90 | 53 +++++++++++++++++++++++++++ 4 files changed, 69 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr92050.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 82bc450fda6..5aeacc1781a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2019-10-11 Tobias Burnus + + PR fortran/92050 + * trans-expr.c (gfc_conv_procedure_call): Handle code generated + by -fcheck=all. + 2019-10-11 Tobias Burnus * f95-lang.c (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Re-define to diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 965ab7786a1..65238ff623d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -7031,8 +7031,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_allocate_lang_decl (result); GFC_DECL_SAVED_DESCRIPTOR (result) = parmse.expr; gfc_free_expr (class_expr); - gcc_assert (parmse.pre.head == NULL_TREE - && parmse.post.head == NULL_TREE); + /* -fcheck= can add diagnostic code, which has to be placed before + the call. */ + if (parmse.pre.head != NULL) + gfc_add_expr_to_block (&se->pre, parmse.pre.head); + gcc_assert (parmse.post.head == NULL_TREE); } /* Follow the function call with the argument post block. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c18cb5fa6f7..488eba91b93 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-10-11 Tobias Burnus + + PR fortran/92050 + * gfortran.dg/pr92050.f90: New. + 2019-10-11 Richard Biener PR tree-optimization/90883 diff --git a/gcc/testsuite/gfortran.dg/pr92050.f90 b/gcc/testsuite/gfortran.dg/pr92050.f90 new file mode 100644 index 00000000000..64193878d8f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr92050.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! { dg-options "-fcheck=all" } +! { dg-shouldfail "above upper bound" } +! +! PR fortran/92050 +! +! +module buggy + implicit none (type, external) + + type :: par + contains + procedure, public :: fun => fun_par + end type par + + type comp + class(par), allocatable :: p + end type comp + + type foo + type(comp), allocatable :: m(:) + end type foo + +contains + + function fun_par(this) + class(par) :: this + integer :: fun_par(1) + fun_par = 42 + end function fun_par + + subroutine update_foo(this) + class(foo) :: this + write(*,*) this%m(1)%p%fun() + end subroutine update_foo + + subroutine bad_update_foo(this) + class(foo) :: this + write(*,*) this%m(2)%p%fun() + end subroutine bad_update_foo +end module buggy + +program main + use buggy + implicit none (type, external) + type(foo) :: x + allocate(x%m(1)) + allocate(x%m(1)%p) + call update_foo(x) + call bad_update_foo(x) +end program main + +! { dg-output "At line 39 of file .*pr92050.f90.*Fortran runtime error: Index '2' of dimension 1 of array 'this%m' above upper bound of 1" } -- 2.30.2