[PATCH] Fix PR105582 ICE on procedure pointer assignment inside block

From 335403bd808e5f1f0431a627c1925a2c758b8fef Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Tue, 26 May 2026 19:21:52 -0700
Subject: [PATCH] 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.
---
 gcc/fortran/trans-decl.cc                     |  7 ++-
 .../gfortran.dg/block_proc_ptr_1.f90          | 43 +++++++++++++++++++
 2 files changed, 49 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/block_proc_ptr_1.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e6c9eaf1796..ee33616556c 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 00000000000..49cedfa7f2a
--- /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
-- 
2.54.0