Fortran: Supply a missing dereference [PR92586]

2023-08-26  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/92586
	* trans-expr.cc (gfc_trans_arrayfunc_assign): Supply a missing
	dereference for the call to gfc_deallocate_alloc_comp_no_caf.

gcc/testsuite/
	PR fortran/92586
	* gfortran.dg/pr92586.f90 : New test
This commit is contained in:
Paul Thomas 2023-08-26 14:37:49 +01:00
parent e7545cadbe
commit 44bcb51eb0
2 changed files with 63 additions and 1 deletions

View File

@ -11171,7 +11171,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
if (expr1->ts.type == BT_DERIVED
&& expr1->ts.u.derived->attr.alloc_comp)
{
tmp = gfc_deallocate_alloc_comp_no_caf (expr1->ts.u.derived, se.expr,
tmp = build_fold_indirect_ref_loc (input_location, se.expr);
tmp = gfc_deallocate_alloc_comp_no_caf (expr1->ts.u.derived, tmp,
expr1->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}

View File

@ -0,0 +1,61 @@
! { dg-do compile }
!
! Contributed by Emanuele Pagone <epagone@email.it>
!
module foo_m
implicit none
type :: string
character(len=:), allocatable :: s
end type string
type :: foo_t
type(string), allocatable :: foo_s(:)
contains
procedure, public :: get_s
end type foo_t
type :: data_t
integer :: n_foo_s
type(foo_t), allocatable :: foo(:)
contains
procedure, public :: data_get_foo_s
end type data_t
contains
function get_s(self)
class(foo_t), intent(in) :: self
type(string) :: get_s( size(self%foo_s) )
get_s = self%foo_s
end function get_s
function data_get_foo_s(self, ith)
class(data_t), intent(in) :: self
integer, intent(in) :: ith
type(string) :: data_get_foo_s(self%n_foo_s)
data_get_foo_s = self%foo(ith)%get_s() ! The lhs was not dereferenced in a byref call.
end function data_get_foo_s
end module foo_m
program bug_stringifor
use foo_m
implicit none
type(data_t) :: data
type(string), allocatable :: bar(:)
allocate( data%foo(1) )
data%foo(1)%foo_s = [string("alpha"), string("bravo"), string("charlie"), &
string("delta"), string("foxtrot")]
data%n_foo_s = 5
bar = data%data_get_foo_s(1)
print *, "bar = ", bar(1)%s
end program bug_stringifor