[PATCH 1/6] gdb: a number of fixes for .gdb_index parsing

[Andrew Burgess <aburgess@redhat.com>]

I recently posted a patch which Simon pointed out during review caused
GDB to crash when running with cc-with-gdb-index board.  The problem
was that I was now generating an invalid .gdb_index section.

This got me thinking, rather than crashing, GDB should really be
rejecting the index as invalid.  GDB should not treat the .gdb_index
as trusted input.  Even if we take the position that GDB will always
generate valid .gdb_index sections, there's nothing to say that some
other tool might try to generate .gdb_index sections, and do it wrong.
We also write the .gdb_index into the index cache, disk corruption
could result in an invalid .gdb_index being read back in later.

This commit includes a number of fixes which I detail below, but the
most important thing here is the addition of the 'gdb_index' proc to
testsuite/lib/dwarf.exp.  This proc started as a copy of 'proc
debug_names' but updated to emit .gdb_index sections.  This proc has
been further modified to allow invalid indexes to be generated.  I
believe all of the features I've added so far are documented in the
comments, so I'll not repeat it all here, but the general idea is to
allow every offset to be overridden to allow for invalid offsets to be
encoded into the .gdb_index.  There are also options to allow parts of
the index to be elided completely.

Not every override feature of 'proc gdb_index' has a matching test
right now.  If I'd done that then I was worried that the GDB side
fixes would be too large for a single patch.  Further patches in this
series will make use of the currently unused features.

Currently, in dwarf2/read-gdb-index.c, I have the following fixes:

In mapped_gdb_index::build_name_components:

  (1) If the name index in the .gdb_index's symbol table is out of
      bounds of the constant pool then ignore this symbol table entry.

  (2) Add an assert that the components list will contain at least
      one entry, even an empty string will result in a single
      component, the empty string.

  (3) When processing the CU vector, if the declared CU vector length
      is larger than the constant pool then ignore this CU vector.

  (4) If we end up with an empty component string after splitting a
      name from the index, then don't try to call .back() on the empty
      string.

In read_gdb_index_from_buffer:

  (5) If the symbol table is not empty, but the constant pool doesn't
      end with a null character then reject this index.  A non-empty
      symbol table means that there must be strings in the constant
      pool's string table.  The strings in this table are
      null-terminated.  And the string table is at the end of the
      constant pool.  Therefore, the last byte in the constant pool
      must be a null character.

      If this is not the case then reading strings from the constant
      pool might not be null-terminated, and might read outside the
      constant pool.

      Placing this check here means that we can later on assume that
      any string read from the constant pool is null-terminated
      without reading outside the constant pool.

In mapped_gdb_index::set_main_name:

  (6) If the main function name is outside the bounds of the constant
      pool then warn, and ignore the main function name.

  (7) Assert that the constant pool is null-terminated, see (5) above.
---
 gdb/dwarf2/read-gdb-index.c                   |  85 ++-
 .../gdb.dwarf2/gdb-index-corrupted.c          |  47 ++
 .../gdb.dwarf2/gdb-index-corrupted.exp        | 367 ++++++++++++
 gdb/testsuite/lib/dwarf.exp                   | 531 ++++++++++++++++++
 4 files changed, 1022 insertions(+), 8 deletions(-)
 create mode 100644 gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.exp

diff --git a/gdb/dwarf2/read-gdb-index.c b/gdb/dwarf2/read-gdb-index.c
index 324984c0de2..86512c4ab9c 100644
--- a/gdb/dwarf2/read-gdb-index.c
+++ b/gdb/dwarf2/read-gdb-index.c
@@ -187,8 +187,9 @@ struct mapped_gdb_index
   const char *symbol_name_at (offset_type idx,
 			      dwarf2_per_objfile *per_objfile) const
   {
-    return (const char *) (this->constant_pool.data ()
-			   + symbol_name_index (idx));
+    offset_type name_index = symbol_name_index (idx);
+    gdb_assert (name_index < this->constant_pool.size ());
+    return (const char *) (this->constant_pool.data () + name_index);
   }
 
   size_t symbol_name_count () const
@@ -218,6 +219,17 @@ mapped_gdb_index::build_name_components (dwarf2_per_objfile *per_objfile)
       if (this->symbol_name_slot_invalid (idx))
 	continue;
 
+      /* If the name offset is out of range for the constant pool then
+	 we cannot get a valid string.  We just skip this symbol.  */
+      if (this->symbol_name_index (idx) >= this->constant_pool.size ())
+	{
+	  complaint (_(".gdb_index entry %s has bad name offset %s [in module %s]"),
+		     pulongest (idx),
+		     pulongest (this->symbol_name_index (idx)),
+		     objfile_name (per_objfile->objfile));
+	  continue;
+	}
+
       const char *name = this->symbol_name_at (idx, per_objfile);
 
       /* This code only knows how to break apart components of C++
@@ -256,9 +268,25 @@ mapped_gdb_index::build_name_components (dwarf2_per_objfile *per_objfile)
 	  lang = (components.size () == 1) ? language_unknown : language_go;
 	}
 
+      /* Even if NAME was the empty string then COMPONENTS will contain one
+	 entry, the empty string.  */
+      gdb_assert (components.size () > 0);
+
       std::vector<cooked_index_entry *> these_entries;
       offset_view vec (constant_pool.slice (symbol_vec_index (idx)));
       offset_type vec_len = vec[0];
+
+      /* Bounds check VEC_LEN against the CONSTANT_POOL.  */
+      if (vec_len >= vec.size ())
+	{
+	  /* The vector count would exceed the available space in the
+	     constant pool.  This is a corrupt .gdb_index.  We could
+	     treat everything up to the end of the constant pool as a
+	     valid vector, but we have no reason to think that's not
+	     also wrong.  Instead just pretend this vector is empty.  */
+	  vec_len = 0;
+	}
+
       for (offset_type vec_idx = 0; vec_idx < vec_len; ++vec_idx)
 	{
 	  offset_type cu_index_and_attrs = vec[vec_idx + 1];
@@ -347,9 +375,15 @@ mapped_gdb_index::build_name_components (dwarf2_per_objfile *per_objfile)
       if (components.size () > 1)
 	{
 	  std::string_view penultimate = components[components.size () - 2];
-	  std::string_view prefix (name, &penultimate.back () + 1 - name);
-
-	  need_parents.emplace_back (prefix, std::move (these_entries));
+	  /* When parsing the DIE, GDB strips out entries with an empty name,
+	     so in a well formed index PENULTIMATE should never be empty.
+	     But the index is external data, so we cannot assume it is well
+	     formed, ignore any empty prefixes.  */
+	  if (penultimate.size () > 0)
+	    {
+	      std::string_view prefix (name, &penultimate.back () + 1 - name);
+	      need_parents.emplace_back (prefix, std::move (these_entries));
+	    }
 	}
     }
 
@@ -502,6 +536,25 @@ read_gdb_index_from_buffer (const char *filename,
 							symbol_table));
     }
 
+  if (!map->symbol_table.empty ())
+    {
+      gdb_assert (!map->constant_pool.empty ());
+
+      if (map->constant_pool[map->constant_pool.size () - 1] != '\0')
+	{
+	  static bool warning_printed = false;
+	  if (!warning_printed)
+	    {
+	      warning (_("skipping .gdb_index in %ps, null byte at end of "
+			 "constant pool is missing"),
+		       styled_string (file_name_style.style (),
+				      filename));
+	      warning_printed = true;
+	    }
+	  return false;
+	}
+    }
+
   return true;
 }
 
@@ -707,10 +760,26 @@ mapped_gdb_index::set_main_name (dwarf2_per_objfile *per_objfile)
     }
   ptr += 4;
 
+  const ULONGEST name_offset
+    = extract_unsigned_integer (ptr, sizeof (offset_type), BFD_ENDIAN_LITTLE);
+
+  if (name_offset >= this->constant_pool.size ())
+    {
+      complaint (_(".gdb_index shortcut table has invalid main name offset %s"),
+		 pulongest (name_offset));
+      return;
+    }
+
+  /* If the symbol table is empty then we ignore the .gdb_index in
+     dwarf2_read_gdb_index.  If the symbol table is not empty, and doesn't
+     end in a '\0' byte then we also ignore the .gdb_index in
+     read_gdb_index_from_buffer.  What this means is that, by the time we
+     get here, we know that the constant pool ends with '\0' and so the
+     MAIN_NAME will be a correctly terminated C style string.  */
+  gdb_assert ((this->constant_pool)[(this->constant_pool).size () - 1]
+	      == '\0');
+
   main_lang = dwarf_lang_to_enum_language (dw_lang);
-  const auto name_offset = extract_unsigned_integer (ptr,
-						     sizeof (offset_type),
-						     BFD_ENDIAN_LITTLE);
   main_name = (const char *) (this->constant_pool.data () + name_offset);
 }
 
diff --git a/gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.c b/gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.c
new file mode 100644
index 00000000000..520df0ce8c4
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.c
@@ -0,0 +1,47 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   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/>.  */
+
+/* Dummy _start function, to be used with -nostartfile.  */
+
+#include <stdlib.h>
+
+volatile int global_var = 0;
+
+void
+_start (void)
+{
+  asm ("_start_label: .globl _start_label");
+
+  /* Some work so that the body of the function is not too small.  */
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+  global_var = global_var + 1;
+
+  exit (0);
+}
diff --git a/gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.exp b/gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.exp
new file mode 100644
index 00000000000..a57b3c26341
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/gdb-index-corrupted.exp
@@ -0,0 +1,367 @@
+# 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/>.
+
+# Test that GDB handles a corrupt .gdb_index gracefully.  This test
+# checks a number of different scenarios, check the 'gdb_index' calls
+# within the 'run_test' proc for details.
+
+load_lib dwarf.exp
+
+require dwarf2_support
+
+# This test installs its own hand-crafted .gdb_index into the
+# executable.  The 'readnow' board forces GDB to ignore the index and
+# read the full debug info, making this test irrelevant.
+require !readnow
+
+standard_testfile
+
+if {[prepare_for_testing "failed to prepare" "${testfile}" \
+	 [list ${srcfile}] {debug ldflags=-nostartfiles}]} {
+    return
+}
+
+set index [have_index $binfile]
+if { ![string eq $index ""] } {
+    unsupported "cache created at compile time"
+    return
+}
+
+set func_info_vars \
+    [get_func_info _start [list debug ldflags=-nostartfiles]]
+
+# TESTNAME is a string that is used to identify the test to run.  This
+# string is used to control how the gdb_index is created, and then
+# what checks are performed on the executable after loading it.
+proc run_test { testname } {
+    set asm_file [standard_output_file ${testname}.S]
+    Dwarf::assemble {
+	filename $asm_file
+	add_dummy_cus 0
+    } {
+	upvar testname testname
+	global func_info_vars
+	foreach var $func_info_vars {
+	    global $var
+	}
+
+	cu { label cu_label } {
+	    compile_unit {
+		DW_AT_language @DW_LANG_C_plus_plus
+	    } {
+		subprogram {
+		    DW_AT_name _start
+		    DW_AT_low_pc $_start_start DW_FORM_addr
+		    DW_AT_high_pc $_start_end DW_FORM_addr
+		    DW_AT_external 1 DW_FORM_flag
+		}
+	    }
+	}
+
+	aranges {} cu_label {
+	    arange {} $_start_start $_start_len
+	}
+
+	if { $testname eq "empty-component" } {
+	    # GDB tries to split entries within the index based on
+	    # '::' by default.  Create an index entry with an empty
+	    # component and ensure that this doesn't trigger undefined
+	    # behaviour in GDB.
+	    gdb_index {} {
+		cu cu_label
+		name "::method" {{cu_label function global}}
+		name _start {{cu_label function global}}
+	    }
+	} elseif { $testname eq "main-name-offset-1" } {
+	    # Add main function details to a basic index, but encode
+	    # an out of range name offset using the special string
+	    # 'end'.  Ensure that GDB doesn't crash and instead just
+	    # ignores the main function details.
+	    #
+	    # Using 'end' here means that the constant pool index used
+	    # for the main entry will point at the first byte after
+	    # the constant pool.  This is the off-by-one boundary
+	    # case.
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		main DW_LANG_C99 end
+	    }
+	} elseif { $testname eq "main-name-offset-2" } {
+	    # Add main function details to a basic index, but encode
+	    # an out of range name offset.  Ensure that GDB doesn't
+	    # crash and instead just ignores the main function details.
+	    #
+	    # This is very similar to the 'main-name-offset-1' test,
+	    # but here the name offset is huge, far past the end of
+	    # the constant pool.  This is far more likely to cause GDB
+	    # to crash.
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		main DW_LANG_C99 0xffffff00
+	    }
+	} elseif { $testname eq "main-language" } {
+	    # Add main function details to a basic index, but encode
+	    # an invalid language number.  Ensure that GDB ignores the
+	    # main function details.
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		main 0xfffff0 _start
+	    }
+	} elseif { $testname eq "no-null" } {
+	    # Create a .gdb_index without a null character at the end
+	    # of the string table.  This is invalid and GDB should just
+	    # ignore this .gdb_index.
+	    gdb_index {
+		no_null true
+	    } {
+		cu cu_label
+		name _start {{cu_label function global}}
+	    }
+	} elseif { $testname eq "skip-constant-pool" } {
+	    # Create a .gdb_index with a non-empty symbol table but an
+	    # empty constant pool.  GDB should ignore this .gdb_index.
+	    gdb_index {
+		skip_index_part { constant_pool }
+	    } {
+		cu cu_label
+		name _start {{cu_label function global}}
+	    }
+	} elseif { $testname eq "long-cu-vector" } {
+	    # Create a .gdb_index containing a CU vector in the
+	    # constant pool where the vector length is invalid.
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		name foo {99999 {cu_label function global}}
+	    }
+	} elseif { $testname eq "name-offset-1" } {
+	    # Add a symbol to the index whose name offset in the symbol
+	    # table is out of range.  The slot still has a valid CU
+	    # vector, so GDB won't treat it as an empty slot and will
+	    # try to read the name.  Ensure GDB doesn't crash and
+	    # instead just ignores this one symbol.
+	    #
+	    # The 'end' offset is exactly the size of the constant pool,
+	    # that is, it points at the first byte after the pool.  This
+	    # is the off-by-one boundary case.
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		name foo {{cu_label function global}} end
+	    }
+	} elseif { $testname eq "name-offset-2" } {
+	    # Just like 'name-offset-1', but here the name offset is
+	    # huge, far past the end of the constant pool.  This is far
+	    # more likely to cause GDB to crash.
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		name foo {{cu_label function global}} 0xffffff00
+	    }
+	} elseif { $testname eq "valid-index" } {
+	    # Generate a well-formed index that includes a valid main
+	    # function (valid language, with the name pointing at the
+	    # '_start' symbol).  This is a sanity check that index
+	    # generation works, at one point this got broken and this
+	    # wasn't spotted straight away as every index was broken
+	    # in some subtle way.
+	    #
+	    # The C language is used, rather than C++, for the main
+	    # function as for C++/Ada GDB only honours an IS_MAIN entry
+	    # whose name is literally "main".
+	    gdb_index {} {
+		cu cu_label
+		name _start {{cu_label function global}}
+		name foo {{cu_label function global}}
+		main DW_LANG_C99 _start
+	    }
+	} else {
+	    perror "invalid testname '$testname' during .gdb_index creation"
+	}
+    }
+
+    set testfile ${::testfile}-${testname}
+    set binfile [standard_output_file $testfile]
+    if {[build_executable "build executable" \
+	     $testfile "$asm_file $::srcfile" \
+	     [list ldflags=-nostartfiles]] == -1} {
+	return
+    }
+
+    clean_restart
+
+    gdb_test_no_output "maint set dwarf synchronous on"
+    gdb_test_no_output "set complaints 100"
+
+    # Loading the binary should not crash despite whatever weird
+    # things are in the .gdb_index.
+    gdb_load $binfile
+
+    # If we're using the cc-with-gnu-debuglink board then the debug
+    # information will have been moved to a separate file.
+    if { [section_get $binfile ".gnu_debuglink"] eq "" } {
+	set suffix ""
+    } else {
+	# If we are using a debuglink then assume the debug is moved
+	# into a file with a .debug suffix.
+	set suffix ".debug"
+    }
+
+    # Setup the expected results based on the testname.
+    if { $testname eq "empty-component" } {
+	set expect_gdb_index_ignored false
+	set expect_start true
+	set expect_method true
+	set expect_main false
+	set expect_foo false
+	set expect_name_count 2
+	set expect_warning_re ""
+    } elseif { $testname eq "main-name-offset-1" \
+		   || $testname eq "main-name-offset-2" \
+		   || $testname eq "main-language" \
+		   || $testname eq "long-cu-vector" \
+		   || $testname eq "name-offset-1" \
+		   || $testname eq "name-offset-2" } {
+	set expect_gdb_index_ignored false
+	set expect_start true
+	set expect_method false
+	set expect_main false
+	set expect_foo false
+	set expect_name_count 1
+	if { $testname eq "main-language" } {
+	    set expect_warning_re "\r\nDuring symbol reading: \\.gdb_index shortcut table has invalid main language $::decimal\r\n"
+	} elseif { $testname eq "main-name-offset-1" \
+		       || $testname eq "main-name-offset-2" } {
+	    set expect_warning_re "\r\nDuring symbol reading: \\.gdb_index shortcut table has invalid main name offset $::decimal\r\n"
+	} elseif { $testname eq "name-offset-1" \
+		       || $testname eq "name-offset-2" } {
+	    set expect_warning_re "\r\nDuring symbol reading: \\.gdb_index entry $::decimal has bad name offset $::decimal \\\[in module \[^\r\n\]+\\\]\r\n"
+	} else {
+	    set expect_warning_re ""
+	}
+    } elseif { $testname eq "valid-index" } {
+	# This is a well-formed index, so GDB should see _start and
+	# should recognise it as the main function.
+	set expect_gdb_index_ignored false
+	set expect_start true
+	set expect_method false
+	set expect_main true
+	set expect_foo true
+	set expect_name_count 2
+	set expect_warning_re ""
+    } elseif { $testname eq "no-null"
+	       || $testname eq "skip-constant-pool" } {
+	set expect_gdb_index_ignored true
+	if { $testname eq "no-null" } {
+	    set expect_warning_re "\r\nwarning: skipping .gdb_index in \[^\r\n\]+, null byte at end of constant pool is missing\r\n"
+	} else {
+	    set expect_warning_re ""
+	}
+
+	# No need to set any of the other EXPECTED_* variables as they
+	# will never be used.
+    } else {
+	perror "invalid testname '$testname' during index check"
+    }
+
+    # Check the expected warning was emitted while loading the
+    # executable.  The GDB_FILE_CMD_MSG global was set by the call to
+    # gdb_load above.
+    if { $expect_warning_re ne "" } {
+	gdb_assert { [regexp $expect_warning_re $::gdb_file_cmd_msg] } \
+	    "index rejected with expected warning"
+    } else {
+	gdb_assert { ![regexp "\r\nDuring symbol reading: " \
+			   $::gdb_file_cmd_msg] \
+			 && ![regexp "\r\nwarning: " \
+				  $::gdb_file_cmd_msg] } \
+	    "index loaded without any warnings or complaints"
+    }
+
+    # Check if GDB used a .gdb_index section, or ignored it.
+    set index [get_index_type [file tail $binfile]$suffix]
+    if { $expect_gdb_index_ignored } {
+	gdb_assert { [string equal $index "cooked"] } ".gdb_index ignored"
+
+	# Ensure that an attempt to expand all symtabs doesn't crash GDB,
+	# even when the index is corrupted as it is in this test.
+	gdb_test_no_output "maint expand-symtabs" "expand all symtabs"
+
+	return
+    } else {
+	gdb_assert { [string equal $index "gdb"] } ".gdb_index used"
+    }
+
+    # Take a look at the details of the loaded .gdb_index and check
+    # that they match the expected results.
+    set saw_start false
+    set saw_method false
+    set saw_foo false
+    set saw_main ""
+    set name_count 0
+    gdb_test_multiple "maint print objfiles" "" -lbl {
+	-re "^\r\n\\s+name:\\s+(\[^\r\n\]+)(?=\r\n)" {
+	    incr name_count
+	    set name $expect_out(1,string)
+	    if { $name eq "_start" } {
+		set saw_start true
+	    } elseif { $name eq "method" } {
+		set saw_method true
+	    } elseif { $name eq "foo" } {
+		set saw_foo true
+	    }
+	    exp_continue
+	}
+	-re "^\r\n\\s+main: \\(\\(cooked_index_entry \\*\\) ($::decimal|$::hex)\\)\[^\r\n\]*(?=\r\n)" {
+	    set offset $expect_out(1,string)
+	    if { $offset eq "0" } {
+		set saw_main false
+	    } else {
+		set saw_main true
+	    }
+	    exp_continue
+	}
+	-re "^\r\n$::gdb_prompt $" {
+	    gdb_assert { $saw_start == $expect_start \
+			     && $saw_method == $expect_method \
+			     && $saw_main == $expect_main \
+			     && $name_count == $expect_name_count \
+			     && $saw_foo == $expect_foo } \
+		$gdb_test_name
+	}
+    }
+
+    # Ensure that an attempt to expand all symtabs doesn't crash GDB,
+    # even when the index is corrupted as it is in this test.
+    gdb_test_no_output "maint expand-symtabs" "expand all symtabs"
+}
+
+set tests { empty-component \
+		main-name-offset-1 \
+		main-name-offset-2 \
+		main-language \
+		no-null \
+		skip-constant-pool \
+		long-cu-vector \
+		name-offset-1 \
+		name-offset-2 \
+		valid-index }
+
+foreach_with_prefix test $tests {
+    run_test $test
+}
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index b3c77864719..7a82f3915d3 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -585,6 +585,11 @@ namespace eval Dwarf {
     # otherwise false.
     variable _cu_is_fission
 
+    # The total lengths of each CU/TU unit as an associative array,
+    # keyed by the unit's label.  This is used by the .gdb_index
+    # generator (see 'gdb_index') to emit a correct CU length.
+    variable _cu_lengths
+
     # When assembling, this is used to stash the level in which any
     # code should be evaluated.
     variable _level
@@ -1796,6 +1801,7 @@ namespace eval Dwarf {
 	variable _cu_addr_size
 	variable _cu_offset_size
 	variable _cu_is_fission
+	variable _cu_lengths
 	variable _level
 
 	# Establish the defaults.
@@ -1858,6 +1864,9 @@ namespace eval Dwarf {
 	set start_label [_compute_label "cu${cu_num}_start"]
 	set end_label [_compute_label "cu${cu_num}_end"]
 
+	# Record the length of this CU.
+	set _cu_lengths($_cu_label) "$end_label - $_cu_label"
+
 	if { $label != "" } {
 	    upvar $label my_label
 	    set my_label $_cu_label
@@ -1955,6 +1964,7 @@ namespace eval Dwarf {
 	variable _cu_addr_size
 	variable _cu_offset_size
 	variable _cu_is_fission
+	variable _cu_lengths
 	variable _level
 
 	# Establish the defaults.
@@ -2018,6 +2028,9 @@ namespace eval Dwarf {
 	set start_label [_compute_label "cu${cu_num}_start"]
 	set end_label [_compute_label "cu${cu_num}_end"]
 
+	# Record the length of this TU.
+	set _cu_lengths($_cu_label) "$end_label - $_cu_label"
+
 	if { $label != "" } {
 	    upvar $label my_label
 	    set my_label $_cu_label
@@ -3757,6 +3770,524 @@ namespace eval Dwarf {
 	debug_names_end:
     }
 
+    # Compute the .gdb_index hash for NAME.  This must match
+    # mapped_index_string_hash (index version >= 5) from
+    # dwarf2/index-common.c.
+    proc _gdb_index_hash { name } {
+	set r 0
+	foreach c [split $name ""] {
+	    scan $c %c code
+	    if {$code >= 65 && $code <= 90} {
+		set code [expr {$code + 32}]
+	    }
+	    set r [expr {($r * 67 + $code - 113) & 0xFFFFFFFF}]
+	}
+	return $r
+    }
+
+    # Pack a CU vector entry for .gdb_index.  Returns a uint32 with
+    # the CU index in bits 0-23, symbol kind in bits 28-30, and the
+    # static/global flag in bit 31.
+    proc _gdb_index_pack_entry { cu_index kind_str scope_str } {
+	set kinds {none 0 type 1 variable 2 function 3 other 4}
+	set kind_val [dict get $kinds $kind_str]
+	set static_bit [expr {$scope_str eq "static" ? 1 : 0}]
+	return [expr {($static_bit << 31) | ($kind_val << 28)
+		      | ($cu_index & 0xFFFFFF)}]
+    }
+
+    # Emit a .gdb_index section.
+    #
+    # OPTIONS is a list with an even number of elements containing
+    # option-name and option-value pairs.
+    # Current options are:
+    #   version N - the .gdb_index version number
+    #               (default 9)
+    #   no_null true|false
+    #             - when true, omit inserting '\0' bytes after each string
+    #               in the string table.  Failing to do this results in an
+    #               invalid index.  This exists only for testing GDB's error
+    #               handling.
+    #               (default false)
+    #   skip_index_part <parts>
+    #             - skip generating some parts of the .gdb_index.  <parts>
+    #               is a list of part names, each name identifies part of
+    #               the .gdb_index to not generate.  When a part is skipped
+    #               its content is not emitted into the index, but the
+    #               offset to where the content would have been is still
+    #               placed into the index header, the next header offset
+    #               will be at the same location though as the skipped part
+    #               has zero length.  This option is only useful for
+    #               generating invalid .gdb_index sections for testing GDB's
+    #               error handling.  The supported part names are:
+    #               'constant_pool'.
+    #               (default {} -- no .gdb_index parts are skipped)
+    #
+    # BODY is Tcl code that emits the parts which make up the body of
+    # the .gdb_index section.  It is evaluated in the caller's
+    # context.  The following commands are available for the BODY
+    # section:
+    #
+    #   cu <cu-label> [<length>]
+    #     -- add a CU by its label.  The optional <length> overrides the
+    #        CU length written into the CU list.  Normally this length is
+    #        computed automatically to match the actual size of the CU in
+    #        .debug_info; providing a (bogus) override allows GDB's
+    #        handling of an inconsistent CU length to be tested.
+    #
+    #   name <name> <entries> [<name_offset>]
+    #     -- add symbol <name> with its CU vector to the constant pool:
+    #
+    #        The <entries> is a list of {<cu_ref> <kind> <scope>} tuples
+    #        where:
+    #
+    #          <cu_ref> is a CU label as passed to the 'cu' command;
+    #              this is used to calculate the index into the CU list
+    #              within the index.
+    #
+    #              Or, this can be a string 'CU-<index>' where <index>
+    #              is a decimal value which is used as the index.
+    #              This exists for testing, it allows invalid indexes
+    #              to be generated.
+    #
+    #          <kind> is 'none', 'type', 'variable', 'function', or 'other'.
+    #
+    #          <scope> is 'global' or 'static'
+    #
+    #        The optional <name_offset> overrides the name offset that is
+    #        written into this symbol's slot in the symbol table.  Normally
+    #        this offset is computed automatically so that it points at the
+    #        string <name> in the constant pool.  Providing an override
+    #        value allows an invalid (e.g. out of range) offset to be
+    #        encoded for testing GDB's error handling.  The value can be a
+    #        raw number, or the keyword 'end' which resolves to the exact
+    #        size of the constant pool (i.e. one byte past its end).  The
+    #        string <name> is still emitted into the constant pool.
+    #
+    #   main <language> <name>
+    #     -- add symbol <name> of <language> to the index as the entry point
+    #        symbol.
+    #
+    #        For a well formed index the <name> should be something
+    #        declared with the 'name' command above, and is used to
+    #        compute the offset into the constant pool's string table.
+    #
+    #        For testing purposes the <name> can also be a hex or
+    #        decimal value, in which case this is used as the offset,
+    #        without being checked.  This allows for offsets that
+    #        point outside the constant pool.
+    #
+    #        If <name> is the string 'end' then this also generates an
+    #        invalid offset, this offset points exactly to the first
+    #        byte outside the constant pool and is used to test for
+    #        off-by-one errors in GDB.  This does mean that we cannot
+    #        generate a fake index including a function called 'end',
+    #        but this felt like an acceptable tradeoff.
+    #
+    #        The <language> can be any valid DW_LANG_* constant, or for
+    #        testing purposes, any integer, even if this is not a valid
+    #        language.
+    #
+    # Example:
+    #   gdb_index {} {
+    #       cu cu_label
+    #       name "object" {{cu_label type global}}
+    #       name "object::method" {{cu_label function global}}
+    #       name "some_function" {{cu_label function global}}
+    #       main DW_LANG_C99 some_function
+    #   }
+    proc gdb_index { options body } {
+	global decimal
+	variable _cu_lengths
+
+	parse_options {
+	    { version 9 }
+	    { no_null false }
+	    { skip_index_part {} }
+	}
+
+	# Validate the names passed to skip_index_part to catch typos in
+	# tests.
+	foreach part $skip_index_part {
+	    if { [lsearch -exact { constant_pool } $part] == -1 } {
+		error "gdb_index: unknown skip_index_part '$part'"
+	    }
+	}
+
+	# A list of two entry lists describing CUs.  Each sub-list has the
+	# form {label length}.  The <label> is a CU label, created when the
+	# CU itself was created.  The <length> is optional, and will usually
+	# be the empty string, but can be set to a number to override the
+	# automatically calculated length.
+	variable _gdb_index_cus
+	set _gdb_index_cus []
+
+	# A list of lists.  Each sub-list has the form: {name entries
+	# offset}, where <name> is a string, entries is a list of CU
+	# descriptors, and <offset> is usually the empty string, but can be
+	# a number which overrides the offset from the CU vector to the
+	# <name> string.  See _gdb_index_name for more details.
+	variable _gdb_index_names
+	set _gdb_index_names []
+
+	# The value to encode as the main function language.  The
+	# default value 0 is what the .gdb_index uses to indicate no
+	# main language information is present.
+	variable _gdb_index_main_lang
+	set _gdb_index_main_lang 0
+
+	# The main function name.
+	variable _gdb_index_main_name
+	set _gdb_index_main_name ""
+
+	# The index into the constant pool's string table of the main name
+	# string.  For testing this can sometimes be set to an invalid
+	# value, so don't rely on this always pointing into the string
+	# table.
+	variable _gdb_index_main_name_idx
+	set _gdb_index_main_name_idx -1
+
+	# Create an entry in the CU list within the index.  LABEL is created
+	# when the CU itself is created (see the 'label' option for 'proc
+	# cu').  The CU list also encodes the length of the CU.  Usually
+	# this is done automatically, but LENGTH, which is a raw number, can
+	# be used to override this for testing invalid lengths appearing in
+	# the index.
+	proc _gdb_index_cu { label {length ""} } {
+	    variable _gdb_index_cus
+	    lappend _gdb_index_cus [list $label $length]
+	}
+
+	# Implement the 'name' command.  Record a string NAME into the
+	# constant pool's string table, and use ENTRIES_LIST to generate a
+	# CU vector in the constant pool's CU vectors table.
+	#
+	# The CU vector contains the offset of NAME in the string table.
+	# Normally this is calculated automatically, but the optional
+	# NAME_OFFSET can be used to override this offset for testing.
+	# NAME_OFFSET can be a raw number, in which case this is used as the
+	# offset, or it can be the string 'end', which resolves to the exact
+	# size of the constant pool (i.e. one byte past its end).  This is
+	# useful for testing for off-by-one errors in GDB.
+	proc _gdb_index_name { name entries_list {name_offset ""} } {
+	    variable _gdb_index_names
+	    lappend _gdb_index_names [list $name $entries_list $name_offset]
+	}
+
+	# Setup the name and language of the main function, as recorded in
+	# the .gdb_index shortcut table.  The LANG can be a DW_LANG_*
+	# constant, but can also be a raw number, this allows invalid
+	# numbers to be used for testing.
+	#
+	# The NAME should be a string and should match a name passed to the
+	# 'name' command (_gdb_index_name), the offset of that name within
+	# the string table will then be calculated automatically.
+	#
+	# The NAME can also be a raw number, in which case this is used as
+	# the string table offset, this allows invalid offsets to be encoded
+	# for testing purposes.
+	#
+	# Finally, NAME can be the keyword 'end', which resolves to the
+	# exact size of the constant pool (i.e. one byte past its end).
+	# This is useful for testing for off-by-one errors in GDB.  A main
+	# function literally named 'end' cannot be encoded into the index
+	# using this proc.
+	proc _gdb_index_main { lang name } {
+	    variable _gdb_index_main_lang
+	    variable _gdb_index_main_name
+	    variable _gdb_index_main_name_idx
+	    variable _constants
+
+	    if {[regexp -- "^($::hex|$::decimal)$" $lang]} {
+		set _gdb_index_main_lang $lang
+	    } else {
+		set _gdb_index_main_lang $_constants($lang)
+	    }
+
+	    if {[regexp -- "^($::hex|$::decimal)$" $name]} {
+		set _gdb_index_main_name_idx $name
+	    } elseif { $name eq "end" } {
+		set _gdb_index_main_name_idx "end"
+	    } else {
+		set _gdb_index_main_name $name
+	    }
+	}
+
+	with_override Dwarf::cu Dwarf::_gdb_index_cu {
+	with_override Dwarf::name Dwarf::_gdb_index_name {
+	with_override Dwarf::main Dwarf::_gdb_index_main {
+	    variable _level
+	    uplevel $_level $body
+	}}}
+
+	set num_names [llength $_gdb_index_names]
+
+	# Compute hash for each name and record the index of the main
+	# function if we find a matching name.
+	set name_idx 0
+	set hashes []
+	foreach entry $_gdb_index_names {
+	    lassign $entry name entries_list
+	    lappend hashes [_gdb_index_hash $name]
+	    if { $_gdb_index_main_lang != 0 } {
+		if { $_gdb_index_main_name eq $name } {
+		    set _gdb_index_main_name_idx $name_idx
+		}
+	    }
+	    incr name_idx
+	}
+
+	# If we have a main function language recorded, but no index then
+	# something has gone wrong.  Maybe the string passed to
+	# _gdb_index_main didn't match any string passed to _gdb_index_name?
+	if { $_gdb_index_main_lang != 0 && $_gdb_index_main_name_idx == -1 } {
+	    perror "failed to find main function '$_gdb_index_main_name'"
+	}
+
+	# If we have a main function defined, but the index version is less
+	# than 9, then this is a mistake, earlier index versions didn't
+	# record this information.
+	if { $_gdb_index_main_lang != 0 && $version < 9 } {
+	    perror "index version $version doesn't include main function details"
+	}
+
+	# Determine hash table size: smallest power of 2 where
+	# occupancy is below 75%.  Minimum size is 2.
+	set table_size 2
+	while { 4 * $num_names >= 3 * $table_size } {
+	    set table_size [expr {$table_size * 2}]
+	}
+
+	# Assign names to hash table slots using open addressing.
+	for {set i 0} {$i < $table_size} {incr i} {
+	    set slot_occupied($i) 0
+	}
+
+	set name_idx 0
+	foreach hash_val $hashes {
+	    set index [expr {$hash_val & ($table_size - 1)}]
+	    set step [expr {(($hash_val * 17) & ($table_size - 1)) | 1}]
+	    while { $slot_occupied($index) } {
+		set index [expr {($index + $step) & ($table_size - 1)}]
+	    }
+	    set slot_occupied($index) 1
+	    set slot_name_idx($index) $name_idx
+	    incr name_idx
+	}
+
+	# Create labels for each name's CU vector and string in the
+	# constant pool.
+	set cu_vec_labels []
+	set str_labels []
+	for {set i 0} {$i < $num_names} {incr i} {
+	    lappend cu_vec_labels [new_label "gdb_index_cu_vec"]
+	    lappend str_labels [new_label "gdb_index_str"]
+	}
+
+	# Emit the section.
+	_section ".gdb_index"
+
+	declare_labels gdb_index_start gdb_index_cu_list \
+	    gdb_index_tu_list gdb_index_addr_table \
+	    gdb_index_symtab gdb_index_constant_pool \
+	    gdb_index_constant_pool_end
+
+	if { $version >= 9 } {
+	    declare_labels gdb_index_shortcut
+	}
+
+	# If the main function was given by symbol name, then
+	# _GDB_INDEX_MAIN_NAME_IDX currently holds the index of that name in
+	# the names list.  Now that the string labels and the constant pool
+	# label exist, translate it into the offset of the name's string
+	# within the constant pool, so the shortcut table emission below can
+	# use _GDB_INDEX_MAIN_NAME_IDX directly.  (For a raw numeric offset,
+	# or the 'end' keyword, it already holds the value to emit.)
+	#
+	# After this we no longer need _GDB_INDEX_MAIN_NAME; unset it to
+	# avoid accidental uses below.
+	if { $_gdb_index_main_name ne "" } {
+	    set str_label [lindex $str_labels $_gdb_index_main_name_idx]
+	    set _gdb_index_main_name_idx "$str_label - $gdb_index_constant_pool"
+	}
+	unset _gdb_index_main_name
+
+	gdb_index_start:
+
+	# Header.
+	_op .4byte $version "Version"
+	_op .4byte "$gdb_index_cu_list - $gdb_index_start" \
+	    "CU list offset"
+	_op .4byte "$gdb_index_tu_list - $gdb_index_start" \
+	    "TU list offset"
+	_op .4byte "$gdb_index_addr_table - $gdb_index_start" \
+	    "Address table offset"
+	_op .4byte "$gdb_index_symtab - $gdb_index_start" \
+	    "Symbol table offset"
+	if { $version >= 9 } {
+	    _op .4byte "$gdb_index_shortcut - $gdb_index_start" \
+		"Shortcut table offset"
+	}
+	_op .4byte "$gdb_index_constant_pool - $gdb_index_start" \
+	    "Constant pool offset"
+
+	# CU list.
+	gdb_index_cu_list:
+	foreach cu_rec $_gdb_index_cus {
+	    lassign $cu_rec cu length
+	    upvar $cu tmp
+	    _op_offset 8 $tmp "CU offset"
+	    # Record the CU's length into the index.  In a well formed
+	    # index the length recorded here must match the actual
+	    # length of the CU in .debug_info.  We allow the length to
+	    # be overridden, for testing purposes, by passing a bogus
+	    # length to the 'cu' command.  If that was done then use
+	    # that length instead.
+	    if { $length ne "" } {
+		set cu_length $length
+	    } elseif { [info exists _cu_lengths($tmp)] } {
+		set cu_length $_cu_lengths($tmp)
+	    } else {
+		error "gdb_index: unknown length for CU '$cu'"
+	    }
+	    _op_offset 8 "$cu_length" "CU length"
+	}
+
+	# TU list (empty for now).
+	gdb_index_tu_list:
+
+	# Address table (empty for now).
+	gdb_index_addr_table:
+
+	# Symbol table.
+	gdb_index_symtab:
+	for {set i 0} {$i < $table_size} {incr i} {
+	    if {$slot_occupied($i)} {
+		set idx $slot_name_idx($i)
+		set str_label [lindex $str_labels $idx]
+		set vec_label [lindex $cu_vec_labels $idx]
+
+		# The name offset in the symbol table normally points at the
+		# string emitted in the constant pool, but it can be
+		# overridden (e.g. to an out of range value) for testing.
+		# See the 'name' command in the gdb_index documentation for
+		# details.
+		set name_offset [lindex [lindex $_gdb_index_names $idx] 2]
+		if { $name_offset eq "" } {
+		    _op .4byte \
+			"$str_label - $gdb_index_constant_pool" \
+			"name offset"
+		} elseif { $name_offset eq "end" } {
+		    _op .4byte \
+			"$gdb_index_constant_pool_end - $gdb_index_constant_pool" \
+			"name offset"
+		} else {
+		    _op .4byte "$name_offset" "name offset"
+		}
+		_op .4byte \
+		    "$vec_label - $gdb_index_constant_pool" \
+		    "CU vector offset"
+	    } else {
+		_op .4byte 0 "empty slot"
+		_op .4byte 0 "empty slot"
+	    }
+	}
+
+	# Shortcut table (version 9 only).
+	if { $version >= 9 } {
+	    gdb_index_shortcut:
+	    _op .4byte $_gdb_index_main_lang "Language"
+	    if { $_gdb_index_main_lang == 0 } {
+		_op .4byte 0 "Name offset"
+	    } elseif { $_gdb_index_main_name_idx eq "end" } {
+		_op .4byte \
+		    "$gdb_index_constant_pool_end - $gdb_index_constant_pool" \
+		    "Name offset"
+	    } else {
+		_op .4byte "$_gdb_index_main_name_idx" \
+		    "Name offset"
+	    }
+	}
+
+	# The constant pool is CU vectors first, and then name
+	# strings.
+	gdb_index_constant_pool:
+
+	if { [lsearch -exact $skip_index_part constant_pool] != -1 } {
+	    # We've been asked to not generate the constant pool.  Just make
+	    # sure all of the required labels are defined.  This results in
+	    # an invalid .gdb_index.  We only support this as an option for
+	    # error testing.
+	    for {set i 0} {$i < $num_names} {incr i} {
+		define_label [lindex $cu_vec_labels $i]
+		define_label [lindex $str_labels $i]
+	    }
+	} else {
+	    # Generate the .gdb_index constant pool.
+	    set name_idx 0
+	    foreach entry $_gdb_index_names {
+		lassign $entry name entries_list
+		define_label [lindex $cu_vec_labels $name_idx]
+
+		# Each entry in the ENTRIES_LIST is itself a list
+		# containing the details needed to create an entry in
+		# the CU vector.  Each CU vector starts with a count
+		# of the entries in the list.
+		#
+		# If the first entry in ENTRIES_LIST is a number then
+		# this overrides the entries count.  This allows
+		# invalid entry counts to be generated for testing
+		# reasons.
+		set first [lindex $entries_list 0]
+		if {[string is integer -strict $first]} {
+		    set num_entries $first
+		    set entries_list [lrange $entries_list 1 end]
+		} else {
+		    set num_entries [llength $entries_list]
+		}
+
+		_op .4byte $num_entries "CU vector length"
+		foreach cu_entry $entries_list {
+		    lassign $cu_entry cu_ref kind scope
+		    if { [regexp "^CU-($decimal)$" $cu_ref dummy cu_index] } {
+			# Explicit CU index.
+		    } else {
+			# Each element of _gdb_index_cus is a {label length}
+			# pair.  Find the index of the one whose label matches
+			# CU_REF.
+			set cu_index \
+			    [lsearch -index 0 -exact $_gdb_index_cus $cu_ref]
+			if { $cu_index == -1 } {
+			    error "gdb_index: unknown CU reference: $cu_ref"
+			}
+		    }
+		    set packed [_gdb_index_pack_entry $cu_index $kind $scope]
+		    _op .4byte $packed "CU index and attributes"
+		}
+		incr name_idx
+	    }
+
+	    set name_idx 0
+	    foreach entry $_gdb_index_names {
+		lassign $entry name entries_list
+		define_label [lindex $str_labels $name_idx]
+		if { $no_null } {
+		    # This generates a corrupt index with no '\0' between
+		    # strings or at the end of the string table.  This
+		    # only exists for testing error handling in this case.
+		    _op .ascii [_nz_quote $name]
+		} else {
+		    _op .ascii [_quote $name]
+		}
+		incr name_idx
+	    }
+	}
+
+	# Mark the end of the constant pool.  This allows a name offset of
+	# 'end' to resolve to the exact size of the constant pool.
+	gdb_index_constant_pool_end:
+    }
+
     # Add the strings in ARGS to the .debug_str section, and create a
     # .debug_str_offsets section pointing to those strings.
     # Current options are:
-- 
2.25.4