git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fortran: [PR121628] 

The PR121628 deep-copy helper reused a static seen_derived_types set
across wrapper generation, so recursive allocatable arrays that appeared
multiple times in a derived type caused infinite compile-time recursion.
Save and restore the set around each wrapper build, polish follow-ups,
and add a regression test to keep the scenario covered.

gcc/fortran/ChangeLog:

	PR fortran/121628
	* trans-array.cc (seen_derived_types): Move to file scope and
	preserve/restore around generate_element_copy_wrapper.
	* trans-intrinsic.cc (conv_intrinsic_atomic_op): Reuse
	gfc_trans_force_lval when forcing addressable CAF temps.

gcc/testsuite/ChangeLog:

	PR fortran/121628
	* gfortran.dg/alloc_comp_deep_copy_7.f90: New test.

libgfortran/ChangeLog:

	PR fortran/121628
	* Makefile.in: Keep continuation indentation within 80 columns.
	* aclocal.m4: Regenerate.
	* libgfortran.h: Drop unused forward declaration.

Signed-off-by: Christopher Albert <albert@tugraz.at>
This commit is contained in:
Jerry DeLisle 2025-11-07 18:46:54 -08:00
parent 77e10b47f2
commit a1fe2cfa89
6 changed files with 110 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
gcc/fortran/trans-array.cc
View File

@ -10025,6 +10025,7 @@ enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP,
static gfc_actual_arglist *pdt_param_list;
static bool generating_copy_helper;
static hash_set<gfc_symbol *> seen_derived_types;
/* Forward declaration of structure_alloc_comps for wrapper generator. */
static tree structure_alloc_comps (gfc_symbol *, tree, tree, int, int, int,
@ -10115,6 +10116,17 @@ generate_element_copy_wrapper (gfc_symbol *der_type, tree comp_type,
bool saved_generating = generating_copy_helper;
generating_copy_helper = true;
/* When generating a wrapper, we need a fresh type tracking state to
avoid inheriting the parent context's seen_derived_types, which would
cause infinite recursion when the wrapper tries to handle the same
recursive type. Save elements, clear the set, generate wrapper, then
restore elements. */
vec<gfc_symbol *> saved_symbols = vNULL;
for (hash_set<gfc_symbol *>::iterator it = seen_derived_types.begin ();
it != seen_derived_types.end (); ++it)
saved_symbols.safe_push (*it);
seen_derived_types.empty ();
der_type_ptr = build_pointer_type (comp_type);
dest_typed = fold_convert (der_type_ptr, dest_parm);
src_typed = fold_convert (der_type_ptr, src_parm);
@ -10126,6 +10138,11 @@ generate_element_copy_wrapper (gfc_symbol *der_type, tree comp_type,
0, purpose, caf_mode, NULL, false);
gfc_add_expr_to_block (&block, body);
/* Restore saved symbols. */
seen_derived_types.empty ();
for (unsigned i = 0; i < saved_symbols.length (); i++)
seen_derived_types.add (saved_symbols[i]);
saved_symbols.release ();
generating_copy_helper = saved_generating;
body = gfc_finish_block (&block);
@ -10173,7 +10190,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
int caf_dereg_mode;
symbol_attribute *attr;
bool deallocate_called;
static hash_set<gfc_symbol *> seen_derived_types;
gfc_init_block (&fnblock);
@ -10984,9 +11000,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
false, false, NULL_TREE, NULL_TREE);
gfc_add_expr_to_block (&fnblock, tmp);
}
/* Special case: recursive allocatable array components require runtime
helper to avoid compile-time infinite recursion. Generate a call to
_gfortran_cfi_deep_copy_array with an element copy wrapper. */
/* Special case: recursive allocatable array components require
runtime helpers to avoid compile-time infinite recursion. Generate
a call to _gfortran_cfi_deep_copy_array with an element copy
wrapper. When inside a wrapper, reuse current_function_decl. */
else if (c->attr.allocatable && c->as && cmp_has_alloc_comps && same_type
&& purpose == COPY_ALLOC_COMP && !c->attr.proc_pointer
&& !c->attr.codimension && !caf_in_coarray (caf_mode)
@ -10997,8 +11014,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
tree alloc_expr;
int comp_rank;
/* Get the element type from ctype (which is already the component type).
For arrays, we need the element type, not the array type. */
/* Get the element type from ctype (already the component
type). For arrays we need the element type, not the array
type. */
elem_type = ctype;
if (GFC_DESCRIPTOR_TYPE_P (ctype))
elem_type = gfc_get_element_type (ctype);
@ -11012,29 +11030,36 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
comp_rank);
gfc_add_expr_to_block (&fnblock, alloc_expr);
/* Generate or reuse the element copy helper. Inside an existing helper
we can reuse the current function to prevent recursive generation. */
/* Generate or reuse the element copy helper. Inside an
existing helper we can reuse the current function to
prevent recursive generation. */
if (inside_wrapper)
copy_wrapper = gfc_build_addr_expr (NULL_TREE, current_function_decl);
copy_wrapper
= gfc_build_addr_expr (NULL_TREE, current_function_decl);
else
copy_wrapper = generate_element_copy_wrapper (c->ts.u.derived,
elem_type,
purpose, caf_mode);
copy_wrapper
= generate_element_copy_wrapper (c->ts.u.derived, elem_type,
purpose, caf_mode);
copy_wrapper = fold_convert (helper_ptr_type, copy_wrapper);
/* Build addresses of descriptors. */
dest_addr = gfc_build_addr_expr (pvoid_type_node, dcmp);
src_addr = gfc_build_addr_expr (pvoid_type_node, comp);
/* Build call: _gfortran_cfi_deep_copy_array (&dcmp, &comp, wrapper). */
/* Build call: _gfortran_cfi_deep_copy_array (&dcmp, &comp,
wrapper). */
call = build_call_expr_loc (input_location,
gfor_fndecl_cfi_deep_copy_array, 3,
dest_addr, src_addr, copy_wrapper);
dest_addr, src_addr,
copy_wrapper);
gfc_add_expr_to_block (&fnblock, call);
}
else if (c->attr.allocatable && !c->attr.proc_pointer
&& (add_when_allocated != NULL_TREE || !cmp_has_alloc_comps || !c->as
|| c->attr.codimension || caf_in_coarray (caf_mode)))
&& (add_when_allocated != NULL_TREE
|| !cmp_has_alloc_comps
|| !c->as
|| c->attr.codimension
|| caf_in_coarray (caf_mode)))
{
rank = c->as ? c->as->rank : 0;
if (c->attr.codimension)

33
gcc/fortran/trans-intrinsic.cc
View File

@ -12559,24 +12559,23 @@ conv_intrinsic_atomic_op (gfc_code *code)
else
image_index = integer_zero_node;
/* Create a temporary if value is not already a pointer, or if it's an
address of a constant (which is invalid in C). */
bool need_tmp = !POINTER_TYPE_P (TREE_TYPE (value));
if (POINTER_TYPE_P (TREE_TYPE (value))
&& TREE_CODE (value) == ADDR_EXPR
&& TREE_CONSTANT (TREE_OPERAND (value, 0)))
need_tmp = true;
if (need_tmp)
/* Ensure VALUE names addressable storage: taking the address of a
constant is invalid in C, and scalars need a temporary as well. */
if (!POINTER_TYPE_P (TREE_TYPE (value)))
{
tmp = gfc_create_var (TREE_TYPE (TREE_TYPE (atom)), "value");
if (POINTER_TYPE_P (TREE_TYPE (value)))
gfc_add_modify (&block, tmp,
fold_convert (TREE_TYPE (tmp),
build_fold_indirect_ref (value)));
else
gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), value));
value = gfc_build_addr_expr (NULL_TREE, tmp);
tree elem
= fold_convert (TREE_TYPE (TREE_TYPE (atom)), value);
elem = gfc_trans_force_lval (&block, elem);
value = gfc_build_addr_expr (NULL_TREE, elem);
}
else if (TREE_CODE (value) == ADDR_EXPR
&& TREE_CONSTANT (TREE_OPERAND (value, 0)))
{
tree elem
= fold_convert (TREE_TYPE (TREE_TYPE (atom)),
build_fold_indirect_ref (value));
elem = gfc_trans_force_lval (&block, elem);
value = gfc_build_addr_expr (NULL_TREE, elem);
}
gfc_init_se (&argse, NULL);

23
gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_7.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do compile }
!
! PR fortran/121628
! Test that derived types with multiple recursive allocatable array
! components compile without ICE. This was broken by the initial deep-copy
! patch which caused infinite compile-time recursion due to seen_derived_types
! persisting across wrapper generation.
!
! The fix saves and restores seen_derived_types when generating element
! copy wrappers to prevent inheriting parent context state.
!
program alloc_comp_deep_copy_7
implicit none
type :: nested_t
type(nested_t), allocatable :: children(:)
type(nested_t), allocatable :: relatives(:)
end type nested_t
type(nested_t) :: a
end program alloc_comp_deep_copy_7

15
libgfortran/Makefile.in
View File

@ -1,7 +1,7 @@
# Makefile.in generated by automake 1.15.1 from Makefile.am.
# Makefile.in generated by automake 1.15 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2017 Free Software Foundation, Inc.
# Copyright (C) 1994-2014 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -231,8 +231,8 @@ libgfortran_la_LIBADD =
@LIBGFOR_MINIMAL_FALSE@ runtime/fpu.lo runtime/main.lo \
@LIBGFOR_MINIMAL_FALSE@ runtime/pause.lo runtime/stop.lo
am__objects_3 = runtime/bounds.lo runtime/compile_options.lo \
runtime/deep_copy.lo runtime/memory.lo runtime/string.lo runtime/select.lo \
$(am__objects_1) $(am__objects_2)
runtime/deep_copy.lo runtime/memory.lo runtime/string.lo \
runtime/select.lo $(am__objects_1) $(am__objects_2)
am__objects_4 = generated/matmul_i1.lo generated/matmul_i2.lo \
generated/matmul_i4.lo generated/matmul_i8.lo \
generated/matmul_i16.lo generated/matmul_r4.lo \
@ -1013,9 +1013,9 @@ gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \
@IEEE_SUPPORT_TRUE@ieee/ieee_exceptions.F90 \
@IEEE_SUPPORT_TRUE@ieee/ieee_features.F90
gfor_src = runtime/bounds.c runtime/compile_options.c runtime/deep_copy.c \
runtime/memory.c runtime/string.c runtime/select.c $(am__append_6) \
$(am__append_7)
gfor_src = runtime/bounds.c runtime/compile_options.c \
runtime/deep_copy.c runtime/memory.c runtime/string.c \
runtime/select.c $(am__append_6) $(am__append_7)
i_matmul_c = \
generated/matmul_i1.c \
generated/matmul_i2.c \
@ -4492,6 +4492,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/bounds.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/compile_options.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/convert_char.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/deep_copy.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/environ.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/error.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/fpu.Plo@am__quote@

44
libgfortran/aclocal.m4 vendored
View File

@ -1,6 +1,6 @@
# generated automatically by aclocal 1.15.1 -*- Autoconf -*-
# generated automatically by aclocal 1.15 -*- Autoconf -*-
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -20,7 +20,7 @@ You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically 'autoreconf'.])])
# Copyright (C) 2002-2017 Free Software Foundation, Inc.
# Copyright (C) 2002-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -35,7 +35,7 @@ AC_DEFUN([AM_AUTOMAKE_VERSION],
[am__api_version='1.15'
dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to
dnl require some minimum version. Point them to the right macro.
m4_if([$1], [1.15.1], [],
m4_if([$1], [1.15], [],
[AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl
])
@ -51,14 +51,14 @@ m4_define([_AM_AUTOCONF_VERSION], [])
# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced.
# This function is AC_REQUIREd by AM_INIT_AUTOMAKE.
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
[AM_AUTOMAKE_VERSION([1.15.1])dnl
[AM_AUTOMAKE_VERSION([1.15])dnl
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))])
# AM_AUX_DIR_EXPAND -*- Autoconf -*-
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -110,7 +110,7 @@ am_aux_dir=`cd "$ac_aux_dir" && pwd`
# AM_CONDITIONAL -*- Autoconf -*-
# Copyright (C) 1997-2017 Free Software Foundation, Inc.
# Copyright (C) 1997-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -141,7 +141,7 @@ AC_CONFIG_COMMANDS_PRE(
Usually this means the macro was only invoked conditionally.]])
fi])])
# Copyright (C) 1999-2017 Free Software Foundation, Inc.
# Copyright (C) 1999-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -332,7 +332,7 @@ _AM_SUBST_NOTMAKE([am__nodep])dnl
# Generate code to set up dependency tracking. -*- Autoconf -*-
# Copyright (C) 1999-2017 Free Software Foundation, Inc.
# Copyright (C) 1999-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -408,7 +408,7 @@ AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS],
# Do all the work for Automake. -*- Autoconf -*-
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -605,7 +605,7 @@ for _am_header in $config_headers :; do
done
echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count])
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -629,7 +629,7 @@ AC_SUBST([install_sh])])
# Add --enable-maintainer-mode option to configure. -*- Autoconf -*-
# From Jim Meyering
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -664,7 +664,7 @@ AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
# Check to see how 'make' treats includes. -*- Autoconf -*-
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -714,7 +714,7 @@ rm -f confinc confmf
# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*-
# Copyright (C) 1997-2017 Free Software Foundation, Inc.
# Copyright (C) 1997-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -753,7 +753,7 @@ fi
# Helper functions for option handling. -*- Autoconf -*-
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -782,7 +782,7 @@ AC_DEFUN([_AM_SET_OPTIONS],
AC_DEFUN([_AM_IF_OPTION],
[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
# Copyright (C) 1999-2017 Free Software Foundation, Inc.
# Copyright (C) 1999-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -829,7 +829,7 @@ AC_LANG_POP([C])])
# For backward compatibility.
AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])])
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -848,7 +848,7 @@ AC_DEFUN([AM_RUN_LOG],
# Check to make sure that the build environment is sane. -*- Autoconf -*-
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -929,7 +929,7 @@ AC_CONFIG_COMMANDS_PRE(
rm -f conftest.file
])
# Copyright (C) 2009-2017 Free Software Foundation, Inc.
# Copyright (C) 2009-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -989,7 +989,7 @@ AC_SUBST([AM_BACKSLASH])dnl
_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl
])
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -1017,7 +1017,7 @@ fi
INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
AC_SUBST([INSTALL_STRIP_PROGRAM])])
# Copyright (C) 2006-2017 Free Software Foundation, Inc.
# Copyright (C) 2006-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -1036,7 +1036,7 @@ AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)])
# Check how to create a tarball. -*- Autoconf -*-
# Copyright (C) 2004-2017 Free Software Foundation, Inc.
# Copyright (C) 2004-2014 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,

3
libgfortran/libgfortran.h
View File

@ -914,9 +914,6 @@ internal_proto(xcalloc);
extern void *xrealloc (void *, size_t);
internal_proto(xrealloc);
/* deep_copy.c - Runtime helper for recursive allocatable array components */
struct CFI_cdesc_t;
extern void cfi_deep_copy_array (gfc_array_void *,
gfc_array_void *,
void (*copy_element) (void *, void *));