Fortran: fix initialization of allocatable non-deferred character [PR59252]

PR fortran/59252

gcc/fortran/ChangeLog:

	* trans-expr.cc (gfc_trans_subcomponent_assign): Initialize
	allocatable non-deferred character with NULL properly.

gcc/testsuite/ChangeLog:

	* gfortran.dg/allocatable_char_1.f90: New test.
This commit is contained in:
Harald Anlauf 2025-02-07 21:21:10 +01:00
parent c9b8a8fc55
commit 818c36a85e
2 changed files with 53 additions and 2 deletions

View file

@ -9836,9 +9836,13 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm,
tmp = gfc_trans_alloc_subarray_assign (tmp, cm, expr);
gfc_add_expr_to_block (&block, tmp);
}
else if (init && cm->attr.allocatable && expr->expr_type == EXPR_NULL)
else if (cm->attr.allocatable && expr->expr_type == EXPR_NULL
&& (init
|| (cm->ts.type == BT_CHARACTER
&& !(cm->ts.deferred || cm->attr.pdt_string))))
{
/* NULL initialization for allocatable components. */
/* NULL initialization for allocatable components.
Deferred-length character is dealt with later. */
gfc_add_modify (&block, dest, fold_convert (TREE_TYPE (dest),
null_pointer_node));
}

View file

@ -0,0 +1,47 @@
! { dg-do run }
! { dg-additional-options "-fdump-tree-original" }
!
! PR fortran/59252
module mod
implicit none
type t1
character(256), allocatable :: label
end type t1
type t2
type(t1), allocatable :: appv(:)
end type t2
contains
subroutine construct(res)
type(t2), allocatable, intent(inout) :: res
if (.not. allocated(res)) allocate(res)
end subroutine construct
subroutine construct_appv(appv)
type(t1), allocatable, intent(inout) :: appv(:)
if (.not. allocated(appv)) allocate(appv(20))
end subroutine construct_appv
type(t1) function foo () result (res)
end function foo
end module mod
program testy
use mod
implicit none
type(t2), allocatable :: res
type(t1) :: s
! original test from pr59252
call construct (res)
call construct_appv(res%appv)
deallocate (res)
! related test from pr118747 comment 2:
s = foo ()
end program testy
! { dg-final { scan-tree-dump-not "__builtin_memmove" "original" } }