Speed up lookup of "type_specific_data"

I noticed that "info locals" on a certain large Ada program was very
slow.  I tracked this down to ada_get_tsd_type expanding nearly every
CU in the program.

This patch fixes the problem by changing this code to use the more
efficient lookup_transparent_type which, unlike the Ada-specific
lookup functions, does not try to find all matching instances.

Note that I first tried fixing this by changing ada_find_any_type, but
this did not work -- I may revisit this approach at some later date.

Also note that the copyright dates on the test files are set that way
because I copied them from another test.

New in v2: the new test failed on the Linaro regression tester.
Looking at the logs, it seems that gdb was picking up a 'value' from
libgnat:

    $1 = {<text variable, no debug info>} 0xf7e227a4 <ada.calendar.formatting.value>

This version renames the local variable in an attempt to work around
this.

v3: In v2, while trying to reproduce the problem locally, I
accidentally forgot to commit one of the changes.

gdb/ada-lang.c

@@ -6469,7 +6469,9 @@ ada_get_tsd_type (struct inferior *inf)
   struct ada_inferior_data *data = get_ada_inferior_data (inf);
 
   if (data->tsd_type == 0)
-    data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
+    data->tsd_type
+      = lookup_transparent_type ("<ada__tags__type_specific_data>",
+				 SEARCH_TYPE_DOMAIN);
   return data->tsd_type;
 }
 

gdb/c-lang.c

@@ -935,9 +935,11 @@ class cplus_language : public language_defn
   }
 
   /* See language.h.  */
-  struct type *lookup_transparent_type (const char *name) const override
+  struct type *lookup_transparent_type (const char *name,
+					domain_search_flags flags)
+    const override
   {
-    return cp_lookup_transparent_type (name);
+    return cp_lookup_transparent_type (name, flags);
   }
 
   /* See language.h.  */

gdb/cp-namespace.c

@@ -1024,10 +1024,10 @@ cp_lookup_nested_symbol (struct type *parent_type,
    released version of GCC with such information.)  */
 
 struct type *
-cp_lookup_transparent_type (const char *name)
+cp_lookup_transparent_type (const char *name, domain_search_flags flags)
 {
   /* First, try the honest way of looking up the definition.  */
-  struct type *t = basic_lookup_transparent_type (name);
+  struct type *t = basic_lookup_transparent_type (name, flags);
   const char *scope;
 
   if (t != NULL)

gdb/cp-support.h

@@ -161,7 +161,8 @@ extern struct block_symbol
 			   const struct block *block,
 			   const domain_search_flags domain);
 
-struct type *cp_lookup_transparent_type (const char *name);
+struct type *cp_lookup_transparent_type (const char *name,
+					 domain_search_flags flags);
 
 /* See description in cp-namespace.c.  */
 

gdb/language.h

@@ -349,9 +349,10 @@ struct language_defn
 
   /* Find the definition of the type with the given name.  */
 
-  virtual struct type *lookup_transparent_type (const char *name) const
+  virtual struct type *lookup_transparent_type (const char *name,
+						domain_search_flags flags) const
   {
-    return basic_lookup_transparent_type (name);
+    return basic_lookup_transparent_type (name, flags);
   }
 
   /* Find all symbols in the current program space matching NAME in

gdb/symtab.c

@@ -2694,9 +2694,9 @@ symbol::matches (domain_search_flags flags) const
 /* See symtab.h.  */
 
 struct type *
-lookup_transparent_type (const char *name)
+lookup_transparent_type (const char *name, domain_search_flags flags)
 {
-  return current_language->lookup_transparent_type (name);
+  return current_language->lookup_transparent_type (name, flags);
 }
 
 /* A helper for basic_lookup_transparent_type that interfaces with the
@@ -2705,6 +2705,7 @@ lookup_transparent_type (const char *name)
 static struct type *
 basic_lookup_transparent_type_quick (struct objfile *objfile,
 				     enum block_enum block_index,
+				     domain_search_flags flags,
 				     const lookup_name_info &name)
 {
   struct compunit_symtab *cust;
@@ -2712,14 +2713,14 @@ basic_lookup_transparent_type_quick (struct objfile *objfile,
   const struct block *block;
   struct symbol *sym;
 
-  cust = objfile->lookup_symbol (block_index, name, SEARCH_STRUCT_DOMAIN);
+  cust = objfile->lookup_symbol (block_index, name, flags);
   if (cust == NULL)
     return NULL;
 
   bv = cust->blockvector ();
   block = bv->block (block_index);
 
-  sym = block_find_symbol (block, name, SEARCH_STRUCT_DOMAIN, nullptr);
+  sym = block_find_symbol (block, name, flags, nullptr);
   if (sym == nullptr)
     error_in_psymtab_expansion (block_index, name.c_str (), cust);
   gdb_assert (!TYPE_IS_OPAQUE (sym->type ()));
@@ -2733,6 +2734,7 @@ basic_lookup_transparent_type_quick (struct objfile *objfile,
 static struct type *
 basic_lookup_transparent_type_1 (struct objfile *objfile,
 				 enum block_enum block_index,
+				 domain_search_flags flags,
 				 const lookup_name_info &name)
 {
   const struct blockvector *bv;
@@ -2743,7 +2745,7 @@ basic_lookup_transparent_type_1 (struct objfile *objfile,
     {
       bv = cust->blockvector ();
       block = bv->block (block_index);
-      sym = block_find_symbol (block, name, SEARCH_STRUCT_DOMAIN, nullptr);
+      sym = block_find_symbol (block, name, flags, nullptr);
       if (sym != nullptr)
 	{
 	  gdb_assert (!TYPE_IS_OPAQUE (sym->type ()));
@@ -2761,7 +2763,7 @@ basic_lookup_transparent_type_1 (struct objfile *objfile,
    global blocks.  */
 
 struct type *
-basic_lookup_transparent_type (const char *name)
+basic_lookup_transparent_type (const char *name, domain_search_flags flags)
 {
   struct type *t;
 
@@ -2775,7 +2777,7 @@ basic_lookup_transparent_type (const char *name)
   for (objfile *objfile : current_program_space->objfiles ())
     {
       t = basic_lookup_transparent_type_1 (objfile, GLOBAL_BLOCK,
-					   lookup_name);
+					   flags, lookup_name);
       if (t)
 	return t;
     }
@@ -2783,7 +2785,7 @@ basic_lookup_transparent_type (const char *name)
   for (objfile *objfile : current_program_space->objfiles ())
     {
       t = basic_lookup_transparent_type_quick (objfile, GLOBAL_BLOCK,
-					       lookup_name);
+					       flags, lookup_name);
       if (t)
 	return t;
     }
@@ -2798,7 +2800,7 @@ basic_lookup_transparent_type (const char *name)
   for (objfile *objfile : current_program_space->objfiles ())
     {
       t = basic_lookup_transparent_type_1 (objfile, STATIC_BLOCK,
-					   lookup_name);
+					   flags, lookup_name);
       if (t)
 	return t;
     }
@@ -2806,7 +2808,7 @@ basic_lookup_transparent_type (const char *name)
   for (objfile *objfile : current_program_space->objfiles ())
     {
       t = basic_lookup_transparent_type_quick (objfile, STATIC_BLOCK,
-					       lookup_name);
+					       flags, lookup_name);
       if (t)
 	return t;
     }

gdb/symtab.h

@@ -2307,9 +2307,11 @@ extern void reread_symbols (int from_tty);
    The type returned must not be opaque -- i.e., must have at least one field
    defined.  */
 
-extern struct type *lookup_transparent_type (const char *);
+extern struct type *lookup_transparent_type
+    (const char *name, domain_search_flags flags = SEARCH_STRUCT_DOMAIN);
 
-extern struct type *basic_lookup_transparent_type (const char *);
+extern struct type *basic_lookup_transparent_type
+     (const char *name, domain_search_flags flags = SEARCH_STRUCT_DOMAIN);
 
 /* Macro for name of symbol to indicate a file compiled with gcc.  */
 #ifndef GCC_COMPILED_FLAG_SYMBOL

gdb/testsuite/gdb.ada/tagged-lookup.exp

@@ -0,0 +1,61 @@
+# Copyright 2024 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/>.
+
+# Check that we can print values of parameters of type 'pointer
+# (access) to tagged type'.  See PR gdb/22670.
+
+load_lib "ada.exp"
+
+require allow_ada_tests
+
+standard_ada_testfile foo
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+if {![runto "foo.adb:$bp_location"]} {
+    return
+}
+
+gdb_test_no_output "set debug symtab-create 1"
+
+# The idea here is that just a single CU should be expanded while
+# searching for the tsd type.
+set found_pck 0
+set found_pck2 0
+gdb_test_multiple "print *the_local_var" "only one CU expanded" -lbl {
+    -re ".symtab-create. start_subfile: name = \[^,\]*pck\\.adb, name_for_id = \[^\r\n\]*\r\n" {
+	set found_pck 1
+	exp_continue
+    }
+    -re ".symtab-create. start_subfile: name = \[^,\]*pck2\\.adb, name_for_id = \[^\r\n\]*\r\n" {
+	set found_pck2 1
+	exp_continue
+    }
+    -re ".symtab-create. start_subfile: name = \[^,\]*, name_for_id = \[^\r\n\]*\r\n" {
+	exp_continue
+    }
+    -re -wrap ".* = \\\(n => $decimal\\\)" {
+	if {$found_pck + $found_pck2 == 1} {
+	    pass $gdb_test_name
+	} else {
+	    fail $gdb_test_name
+	}
+    }
+}

gdb/testsuite/gdb.ada/tagged-lookup/foo.adb

@@ -0,0 +1,23 @@
+--  Copyright 2017-2024 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/>.
+
+with Pck; use Pck;
+with Pck2; use Pck2;
+procedure Foo is
+   The_Local_Var : access Top_T2 := new Top_T2'(N => 2);
+begin
+   Inspect (new Top_T'(N => 2)); -- STOP
+   Inspect2 (The_Local_Var);
+end Foo;

gdb/testsuite/gdb.ada/tagged-lookup/pck.adb

@@ -0,0 +1,22 @@
+--  Copyright 2017-2024 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/>.
+
+with Pck2; use Pck2;
+package body Pck is
+   procedure Inspect (Obj: access Top_T'Class) is
+   begin
+      null;
+   end Inspect;
+end Pck;

gdb/testsuite/gdb.ada/tagged-lookup/pck.ads

@@ -0,0 +1,21 @@
+--  Copyright 2017-2024 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/>.
+
+package Pck is
+   type Top_T is tagged record
+      N : Integer := 1;
+   end record;
+   procedure Inspect (Obj: access Top_T'Class);
+end Pck;

gdb/testsuite/gdb.ada/tagged-lookup/pck2.adb

@@ -0,0 +1,21 @@
+--  Copyright 2017-2024 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/>.
+
+package body Pck2 is
+   procedure Inspect2 (Obj: access Top_T2'Class) is
+   begin
+      null;
+   end Inspect2;
+end Pck2;

gdb/testsuite/gdb.ada/tagged-lookup/pck2.ads

@@ -0,0 +1,22 @@
+--  Copyright 2017-2024 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/>.
+
+with Pck; use Pck;
+package Pck2 is
+   type Top_T2 is tagged record
+      N : Integer := 1;
+   end record;
+   procedure Inspect2 (Obj: access Top_T2'Class);
+end Pck2;