From 62ede14d30f5d083f1ab23bcab6e0e3c9c649006 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 27 Mar 2020 12:12:36 +0100 Subject: [PATCH] [Fortran] Fix ICE with deferred-rank arrays (PR93957) PR fortran/93957 * trans-array.c (gfc_alloc_allocatable_for_assignment): Accept nonallocatable, nonpointer deferred-rank arrays. PR fortran/93957 * gfortran.dg/assumed_rank_19.f90: New. --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-array.c | 6 ++- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/assumed_rank_19.f90 | 37 +++++++++++++++++++ 4 files changed, 52 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/assumed_rank_19.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 39aa22df298..02f0141bebf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-03-27 Tobias Burnus + + PR fortran/93957 + * trans-array.c (gfc_alloc_allocatable_for_assignment): Accept + nonallocatable, nonpointer deferred-rank arrays. + 2020-03-27 Tobias Burnus PR fortran/93363 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a4b1cba8501..9c928d04e0a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -10672,7 +10672,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* NULLIFY an allocatable/pointer array on function entry, free it on exit. Do likewise, recursively if necessary, with the allocatable components of - derived types. */ + derived types. This function is also called for assumed-rank arrays, which + are always dummy arguments. */ void gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) @@ -10694,7 +10695,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) /* Make sure the frontend gets these right. */ gcc_assert (sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp - || has_finalizer); + || has_finalizer + || (sym->as->type == AS_ASSUMED_RANK && sym->attr.dummy)); gfc_save_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8107f008999..d5a1c8e1a8e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2020-03-27 Tobias Burnus + + PR fortran/93957 + * gfortran.dg/assumed_rank_19.f90: New. + 2020-03-27 Tobias Burnus PR fortran/93363 diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_19.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_19.f90 new file mode 100644 index 00000000000..f77f6fb47da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_rank_19.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! +! PR fortran/93957 +! +! Contributed by José Rui Faustino de Sousa + +function f_ice(this) result(that) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + integer(kind=c_int), intent(in) :: this(..) + integer(kind=c_int) :: that + + that = size(this) + return +end function f_ice + +program ice_p + use, intrinsic :: iso_c_binding, only: c_int + implicit none + + interface + function f_ice(this) result(that) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + integer(kind=c_int), intent(in) :: this(..) + integer(kind=c_int) :: that + end function f_ice + end interface + + integer(kind=c_int), parameter :: n = 10 + + integer(kind=c_int) :: intp(n) + + if(size(intp)/=n) stop 1 + if(f_ice(intp)/=n) stop 2 +end program ice_p -- 2.30.2