[PATCH] Handle nested Ada functions with gnat-llvm

[Tom Tromey <tromey@adacore.com>]

In Ada, a nested function can refer to variables in lexically
enclosing outer scopes.  Ordinarily this is implemented in DWARF using
DW_AT_static_link, so that the correct outer function invocation can
be found from the nested function.

However, LLVM does not implement the DWARF DW_AT_static_link feature,
so this approach isn't possible.

gnat-llvm, though, implements "unnesting" manually, passing an
activation record parameter to nested functions.  This activation
record can be used to find the correct outer frame.

This patch adds a new language method to enable this.  A new test case
is included; this test will fail if the static link or some similar
feature is not implemented (i.e., a naive unwind looking for the next
instance of the outer function will fail).
---
 gdb/ada-lang.c                                | 83 +++++++++++++++++++
 gdb/frame.c                                   |  6 +-
 gdb/language.c                                |  8 ++
 gdb/language.h                                | 12 +++
 gdb/testsuite/gdb.ada/nested-confounding.exp  | 35 ++++++++
 .../gdb.ada/nested-confounding/nested.adb     | 52 ++++++++++++
 6 files changed, 195 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.ada/nested-confounding.exp
 create mode 100644 gdb/testsuite/gdb.ada/nested-confounding/nested.adb

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 71a338ce17e..2f2c0227322 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -14038,6 +14038,11 @@ class ada_language : public language_defn
   const struct lang_varobj_ops *varobj_ops () const override
   { return &ada_varobj_ops; }
 
+  /* See language.h.  */
+
+  frame_info_ptr follow_static_link (const frame_info_ptr &frame) const
+    override;
+
 protected:
   /* See language.h.  */
 
@@ -14048,6 +14053,84 @@ class ada_language : public language_defn
   }
 };
 
+frame_info_ptr
+ada_language::follow_static_link (const frame_info_ptr &frame) const
+{
+  const block *frame_block = get_frame_block (frame, nullptr);
+  if (frame_block == nullptr)
+    return {};
+  frame_block = frame_block->function_block ();
+
+  /* LLVM doesn't implement DW_AT_static_link, but for Ada we can
+     search for the pointer to the activation record.  Then, we can go
+     up the stack and find the frame where this activation record is
+     defined.  Note that we don't use the activation record directly,
+     because that is type-erased and just holds pointers.  */
+  symbol *arec = nullptr;
+  for (symbol *iter : block_iterator_range (frame_block))
+    {
+      /* The activation record argument is an artificial argument
+	 whose name starts with "AREC".  */
+      if (iter->is_argument () && iter->is_artificial ()
+	  && startswith (iter->linkage_name (), "AREC"))
+	{
+	  arec = iter;
+	  break;
+	}
+    }
+
+  if (arec == nullptr)
+    return {};
+
+  /* We aren't interested in ordinary (non-quit) exceptions that might
+     occur here -- we just want to return an empty frame if something
+     goes wrong.  */
+  try
+    {
+      value *val = read_var_value (arec, frame_block, frame);
+      CORE_ADDR arec_address = value_as_address (val);
+
+      for (frame_info_ptr frame_iter = get_prev_frame (frame);
+	   frame_iter != nullptr;
+	   frame_iter = get_prev_frame (frame_iter))
+	{
+	  /* Stacks can be quite deep: give the user a chance to stop
+	     this.  */
+	  QUIT;
+
+	  frame_block = get_frame_block (frame_iter, nullptr);
+	  if (frame_block == nullptr)
+	    continue;
+	  frame_block = frame_block->function_block ();
+
+	  for (symbol *iter : block_iterator_range (frame_block))
+	    {
+	      /* The activation record itself is an artificial
+		 non-argument of record type, whose name starts with
+		 "AREC", and that has the same address as the argument
+		 passed down to the callee.  */
+	      if (!iter->is_argument () && iter->is_artificial ()
+		  && startswith (iter->linkage_name (), "AREC")
+		  && iter->type ()->code () == TYPE_CODE_STRUCT)
+		{
+		  value *outer = read_var_value (iter, frame_block,
+						 frame_iter);
+		  CORE_ADDR outer_address = outer->address ();
+		  if (outer_address == arec_address)
+		    return frame_iter;
+		}
+	    }
+	}
+    }
+  catch (const gdb_exception_error &ex)
+    {
+      /* Ignore.  */
+    }
+
+  return {};
+}
+
+
 /* Single instance of the Ada language class.  */
 
 static ada_language ada_language_defn;
diff --git a/gdb/frame.c b/gdb/frame.c
index 7a83f5e61c0..06f604a8683 100644
--- a/gdb/frame.c
+++ b/gdb/frame.c
@@ -3245,7 +3245,11 @@ frame_follow_static_link (const frame_info_ptr &initial_frame)
 
   const struct dynamic_prop *static_link = frame_block->static_link ();
   if (static_link == nullptr)
-    return {};
+    {
+      const language_defn *lang
+	= language_def (get_frame_language (initial_frame));
+      return lang->follow_static_link (initial_frame);
+    }
 
   CORE_ADDR upper_frame_base;
 
diff --git a/gdb/language.c b/gdb/language.c
index 439ef293622..4e1dc5682f0 100644
--- a/gdb/language.c
+++ b/gdb/language.c
@@ -917,6 +917,14 @@ language_defn::value_string (struct gdbarch *gdbarch,
 
 /* See language.h.  */
 
+frame_info_ptr
+language_defn::follow_static_link (const frame_info_ptr &frame) const
+{
+  return {};
+}
+
+/* See language.h.  */
+
 struct type *
 language_bool_type (const struct language_defn *la,
 		    struct gdbarch *gdbarch)
diff --git a/gdb/language.h b/gdb/language.h
index b43dae66107..75154d9c591 100644
--- a/gdb/language.h
+++ b/gdb/language.h
@@ -638,6 +638,18 @@ struct language_defn
 
   virtual const struct lang_varobj_ops *varobj_ops () const;
 
+  /* Normally a "static link" (a reference to an outer frame) is
+     represented by DW_AT_static_link in DWARF.  However, some
+     compilers do not emit this -- but do provide some
+     language-specific way to find the correct outer frame.  If the
+     ordinary search for a static link fails for a given frame, then
+     this method will be called for that frame's language.  It should
+     either return the correct outer instance, if one exists, or a
+     null frame if no such frame exists.  */
+
+  virtual frame_info_ptr follow_static_link (const frame_info_ptr &frame)
+    const;
+
 protected:
 
   /* This is the overridable part of the GET_SYMBOL_NAME_MATCHER method.
diff --git a/gdb/testsuite/gdb.ada/nested-confounding.exp b/gdb/testsuite/gdb.ada/nested-confounding.exp
new file mode 100644
index 00000000000..79cf10b3d58
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/nested-confounding.exp
@@ -0,0 +1,35 @@
+# Copyright 2026 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# A test case for a nested function that requires a static link.
+
+load_lib "ada.exp"
+
+require allow_ada_tests
+
+standard_ada_testfile nested
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return
+}
+
+clean_restart ${testfile}
+set bp_location [gdb_get_line_number "BREAK" "${testdir}/nested.adb"]
+runto "nested.adb:$bp_location"
+
+# In the innermost call, the passed id and the reference to the outer
+# id are different.
+gdb_test "print id" [quotemeta {$@DECIMAL = 28}]
+gdb_test "print outer_id" [quotemeta {$@DECIMAL = 23}]
diff --git a/gdb/testsuite/gdb.ada/nested-confounding/nested.adb b/gdb/testsuite/gdb.ada/nested-confounding/nested.adb
new file mode 100644
index 00000000000..44f7c7866fe
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/nested-confounding/nested.adb
@@ -0,0 +1,52 @@
+--  Copyright 2026 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+procedure Nested is
+   type Proc_Access is access procedure (Id: Integer);
+
+   procedure Parent (My_Id : Integer; Call : access procedure (Id: Integer));
+
+   procedure Do_Nothing (Id : Boolean);
+
+   procedure Do_Nothing (Id : Boolean) is
+   begin
+      null;
+   end Do_Nothing;
+
+   procedure Parent (My_Id : Integer; Call : access procedure (Id: Integer)) is
+      procedure Inner (Id : Integer);
+
+      Outer_Id : Integer := My_Id;
+
+      procedure Inner (Id : Integer) is
+      begin
+         Do_Nothing (Id = Outer_Id); -- BREAK
+      end Inner;
+
+   begin
+
+      --  This setup ensures that when Inner is reached, the most
+      --  recent invocation of Parent will not be the correct one for
+      --  the purposes of finding "Outer_Id".
+      if Call = null then
+         Parent (My_Id + 5, Inner'Access);
+      else
+         Call (Outer_Id);
+      end if;
+   end Parent;
+
+begin
+   Parent (23, null);
+end Nested;

base-commit: f797b25fdc7ca4a48c09802082426b71e56898aa
-- 
2.53.0