mirror/gcc
1
0
Fork 0
mirror of https://github.com/gcc-mirror/gcc.git synced 2024-11-21 13:40:47 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fortran: Fix regression caused by r14-9752 [PR114959]

Browse Source 
2024-04-29  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/114959
	* trans-expr.cc (gfc_trans_class_init_assign): Return NULL_TREE
	if the default initializer has all NULL fields. Guard this
	by a requirement that the code not be EXEC_INIT_ASSIGN and that
	the object be an INTENT_OUT dummy.
	* trans-stmt.cc (gfc_trans_allocate): Change the initializer
	code for allocate with mold to EXEC_ALLOCATE to allow an
	initializer with all NULL fields.

gcc/testsuite/
	PR fortran/114959
	* gfortran.dg/pr114959.f90: New test.
This commit is contained in:
Paul Thomas 2024-04-29 11:52:11 +01:00
parent add51a2514
commit bca41a8d55
3 changed files with 54 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/fortran/trans-expr.cc
View File

@ -1720,6 +1720,7 @@ gfc_trans_class_init_assign (gfc_code *code)
gfc_se dst,src,memsz;
gfc_expr *lhs, *rhs, *sz;
gfc_component *cmp;
gfc_symbol *sym;
gfc_start_block (&block);
@ -1736,18 +1737,25 @@ gfc_trans_class_init_assign (gfc_code *code)
/* The _def_init is always scalar. */
rhs->rank = 0;
/* Check def_init for initializers. If this is a dummy with all default
initializer components NULL, return NULL_TREE and use the passed value as
required by F2018(8.5.10). */
if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
/* Check def_init for initializers. If this is an INTENT(OUT) dummy with all
default initializer components NULL, return NULL_TREE and use the passed
value as required by F2018(8.5.10). */
sym = code->expr1->expr_type == EXPR_VARIABLE ? code->expr1->symtree->n.sym
: NULL;
if (code->op != EXEC_ALLOCATE
&& sym && sym->attr.dummy
&& sym->attr.intent == INTENT_OUT)
{
cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
for (; cmp; cmp = cmp->next)
if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
{
if (cmp->initializer)
break;
else if (!cmp->next)
return build_empty_stmt (input_location);
cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
for (; cmp; cmp = cmp->next)
{
if (cmp->initializer)
break;
else if (!cmp->next)
return NULL_TREE;
}
}
}

5
gcc/fortran/trans-stmt.cc
View File

@ -7262,11 +7262,12 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
{
/* Use class_init_assign to initialize expr. */
gfc_code *ini;
ini = gfc_get_code (EXEC_INIT_ASSIGN);
ini = gfc_get_code (EXEC_ALLOCATE);
ini->expr1 = gfc_find_and_cut_at_last_class_ref (expr, true);
tmp = gfc_trans_class_init_assign (ini);
gfc_free_statements (ini);
gfc_add_expr_to_block (&block, tmp);
if (tmp != NULL_TREE)
gfc_add_expr_to_block (&block, tmp);
}
else if ((init_expr = allocate_get_initializer (code, expr)))
{

33
gcc/testsuite/gfortran.dg/pr114959.f90 Normal file
View File

@ -0,0 +1,33 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Fix the regression caused by r14-9752 (fix for PR112407)
! Contributed by Orion Poplawski <orion@nwra.com>
! Problem isolated by Jakub Jelinek <jakub@gcc.gnu.org> and further
! reduced here.
!
module m
type :: smoother_type
integer :: i
end type
type :: onelev_type
class(smoother_type), allocatable :: sm
class(smoother_type), allocatable :: sm2a
end type
contains
subroutine save_smoothers(level,save1, save2)
Implicit None
type(onelev_type), intent(inout) :: level
class(smoother_type), allocatable , intent(inout) :: save1, save2
integer(4) :: info
info = 0
! r14-9752 causes the 'stat' declaration from the first ALLOCATE statement
! to disappear, which triggers an ICE in gimplify_var_or_parm_decl. The
! second ALLOCATE statement has to be present for the ICE to occur.
allocate(save1, mold=level%sm,stat=info)
allocate(save2, mold=level%sm2a,stat=info)
end subroutine save_smoothers
end module m
! Two 'stat's from the allocate statements and two from the final wrapper.
! { dg-final { scan-tree-dump-times "integer\\(kind..\\) stat" 4 "original" } }