https://gcc.gnu.org/g:c567a7760cf3f7821a376b0ee8192ce9d9e5ed42
commit r17-1042-gc567a7760cf3f7821a376b0ee8192ce9d9e5ed42 Author: Jerry DeLisle <[email protected]> Date: Tue May 26 19:21:52 2026 -0700 fortran: fix ICE with procedure pointer declared in BLOCK Procedure pointer declared inside a BLOCK construct in a program that has contained procedures caused an ICE in convert_nonlocal_reference_op (tree-nested.cc) because get_proc_pointer_decl set the proc pointer's DECL_CONTEXT to NULL instead of the enclosing program function decl. The root cause: the condition to call gfc_add_decl_to_function vs gfc_add_decl_to_parent_function checked whether proc_name->backend_decl matched current_function_decl. For a BLOCK namespace the proc_name has FL_LABEL flavor and its backend_decl is never set, so the condition failed and gfc_add_decl_to_parent_function was called. That function sets DECL_CONTEXT to DECL_CONTEXT(current_function_decl), which is NULL for a top-level program. The tree-nested pass then found no nesting level matching target_context = NULL and crashed in the internal_error call dereferencing the NULL target_context. Fix: add the missing BLOCK namespace check (FL_LABEL flavor) so that procedure pointers in BLOCK constructs are treated like regular variables and added to the enclosing function via gfc_add_decl_to_function. Assisted by: Claude Sonnet 4.6 PR fortran/105582 gcc/fortran/ChangeLog: * trans-decl.cc (get_proc_pointer_decl): Add FL_LABEL check to route BLOCK-construct procedure pointers to gfc_add_decl_to_function rather than gfc_add_decl_to_parent_function. gcc/testsuite/ChangeLog: * gfortran.dg/block_proc_ptr_1.f90: New test. Diff: --- gcc/fortran/trans-decl.cc | 7 ++++- gcc/testsuite/gfortran.dg/block_proc_ptr_1.f90 | 43 ++++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index ca9d4d5027df..ea12be5dd258 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -2212,7 +2212,12 @@ get_proc_pointer_decl (gfc_symbol *sym) if ((sym->ns->proc_name && sym->ns->proc_name->backend_decl == current_function_decl) - || sym->attr.contained) + || sym->attr.contained + || (sym->ns->proc_name + && sym->ns->proc_name->attr.flavor == FL_LABEL)) + /* The last condition handles BLOCK constructs: the proc_name has + FL_LABEL flavor and its backend_decl is not set, but the proc pointer + belongs to the enclosing function (current_function_decl). */ gfc_add_decl_to_function (decl); else if (sym->ns->proc_name->attr.flavor != FL_MODULE) gfc_add_decl_to_parent_function (decl); diff --git a/gcc/testsuite/gfortran.dg/block_proc_ptr_1.f90 b/gcc/testsuite/gfortran.dg/block_proc_ptr_1.f90 new file mode 100644 index 000000000000..49cedfa7f2a7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/block_proc_ptr_1.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! PR fortran/105582 +! Procedure pointer declared inside a BLOCK construct in a program that has +! contained procedures used to cause an ICE in convert_nonlocal_reference_op +! (tree-nested.cc) because get_proc_pointer_decl erroneously called +! gfc_add_decl_to_parent_function instead of gfc_add_decl_to_function, +! leaving the decl with DECL_CONTEXT set to NULL instead of the enclosing +! program's function_decl. + +module iface_m + implicit none + abstract interface + pure function init_i(x) result(y) + double precision, intent(in) :: x(:) + double precision, allocatable :: y(:) + end function + end interface +end module + +program test_block_proc_ptr + use iface_m, only : init_i + implicit none + integer :: n = 0 + + block + procedure(init_i), pointer :: p + double precision, allocatable :: vals(:) + p => linear + vals = p([1d0, 2d0, 3d0]) + if (any(abs(vals - [1d0, 2d0, 3d0]) > 1d-10)) n = n + 1 + end block + + if (n /= 0) stop 1 + +contains + + pure function linear(x) result(y) + double precision, intent(in) :: x(:) + double precision, allocatable :: y(:) + y = x + end function + +end program
