(Ada) fix GDB crash printing packed array

Trying to print a packed array sometimes leads to a crash (see
attached testcase for an example of when this happens):

  | (gdb) p bad
  | [1]    65571 segmentation fault  gdb -q foo

Variable "bad" is declared in the debug information as an array where
the array's type name has an XPnnn suffix:

  | .uleb128 0xc    # (DIE (0x566) DW_TAG_typedef)
  | .long   .LASF200        # DW_AT_name: "pck__t___XP1"
  | [loc info attributes snipped]
  | .long   0x550   # DW_AT_type
  | .byte   0x1     # DW_AT_alignment

The signals to GDB that the debugging information follows a GNAT encoding
used for packed arrays, and an in order to decode it, we need to find
the type whose name is the same minus the "___XPnnn" suffix: "pck__t".

For that, we make a call to ada-lang.c::standard_lookup, which is
a simple function which essentially does:

  | /* Return the result of a standard (literal, C-like) lookup of NAME in
  |    given DOMAIN, visible from lexical block BLOCK.  */
  |
  |   [...]
  |   sym = lookup_symbol_in_language (name, block, domain, language_c, 0);

Unfortunately for us, while the intent of this call was to perform
an exact-match lookup, in our case, it returns ... type pck__t___XP1
instead! In other words, it finds itself back. The reason why it finds
this type is a confluence of two factors:

  (1) Forcing the lookup into language_c currently does not affect
      how symbol matching is done anymore, because we look at the symbol's
      language to determine which kind of matching should be done;

  (2) The lookup searches the local context (via block) first, beforei
      doing a more general lookup. And looking at the debug info for
      the main subprogram, we see that type "pck__t" is not declared
      there, only in the debug info for pck.ads. In other words,
      there is no way that we accidently find "pck__t" by random chance.

I believe Pedro added a new function called ada_lookup_encoded_symbol
for that specific purpose, so I started by replacing the lookup
by language above by this. Unfortunately, still no joy.

This was because, even though ada_lookup_encoded_symbol puts angle-
brackets around the search name to signal that we want a verbatim
search, we end up losing that information in the function called
to compare a symbol with the search name:

  | static bool
  | do_full_match (const char *symbol_search_name,
  |                const lookup_name_info &lookup_name,
  |                completion_match_result *comp_match_res)
  | {
  |   return full_match (symbol_search_name, ada_lookup_name (lookup_name));
                                             ^^^^^^^^^^^^^^^
                                                    |
                                    <=> lookup_name.m_ada.m_encoded_name
                                           (no angle brackets)

The way I fixed this was by introducing a new function called
do_exact_match, and then adjust ada_get_symbol_name_matcher to
return that function when seeing that we have a verbatim non-wild-match
search.

As it happens, this fixes an incorrect test in gdb.ada/homony.exp,
where we were inserting a breakpoint on a symbol using the angle-brackets
notation, and got 2 locations for that breakpoint...

    (gdb) b <homonym__get_value>
    Breakpoint 1 at 0x4029fc: <homonym__get_value>. (2 locations)

...  each location being in a different function:

    (gdb) info break
    Num     Type           Disp Enb Address            What
    1       breakpoint     keep y   <MULTIPLE>
    1.1                         y   0x00000000004029fc in homonym.get_value
                                    at /[...]/homonym.adb:32
    1.2                         y   0x0000000000402a3a in homonym.get_value
                                    at /[...]/homonym.adb:50
    (gdb) x /i 0x00000000004029fc
       0x4029fc <homonym__get_value+8>:     movl   $0x1d,-0x4(%rbp)
    (gdb) x /i 0x0000000000402a3a
       0x402a3a <homonym__get_value__2+8>:  movl   $0x11,-0x4(%rbp)

Since we used angle-brackets, we shouldn't be matching the second one,
something this patch fixes.

gdb/ChangeLog:

        * ada-lang.c (standard_lookup): Use ada_lookup_encoded_symbol
        instead of lookup_symbol_in_language
        (do_exact_match): New function.
        (ada_get_symbol_name_matcher): Return do_exact_match when
        doing a verbatim match.

gdb/testsuite/ChangeLog:

        * gdb.ada/big_packed_array: New testcase.
        * gdb.ada/homonym.exp: Fix incorrect expected output for
        "break <homonym__get_value>" test.

Tested on x86_64-linux.

Author: brobecke

gdb/ChangeLog

@@ -1,3 +1,11 @@
+2019-02-17  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-lang.c (standard_lookup): Use ada_lookup_encoded_symbol
+	instead of lookup_symbol_in_language
+	(do_exact_match): New function.
+	(ada_get_symbol_name_matcher): Return do_exact_match when
+	doing a verbatim match.
+
 2019-02-15  Tom Tromey  <tromey@adacore.com>
 
 	* ravenscar-thread.c (ravenscar_thread_target::resume)

gdb/ada-lang.c

@@ -4760,7 +4760,7 @@ standard_lookup (const char *name, const struct block *block,
 
   if (lookup_cached_symbol (name, domain, &sym.symbol, NULL))
     return sym.symbol;
-  sym = lookup_symbol_in_language (name, block, domain, language_c, 0);
+  ada_lookup_encoded_symbol (name, block, domain, &sym);
   cache_symbol (name, domain, sym.symbol, sym.block);
   return sym.symbol;
 }
@@ -14175,6 +14175,16 @@ do_full_match (const char *symbol_search_name,
   return full_match (symbol_search_name, ada_lookup_name (lookup_name));
 }
 
+/* symbol_name_matcher_ftype for exact (verbatim) matches.  */
+
+static bool
+do_exact_match (const char *symbol_search_name,
+		const lookup_name_info &lookup_name,
+		completion_match_result *comp_match_res)
+{
+  return strcmp (symbol_search_name, ada_lookup_name (lookup_name)) == 0;
+}
+
 /* Build the Ada lookup name for LOOKUP_NAME.  */
 
 ada_lookup_name_info::ada_lookup_name_info (const lookup_name_info &lookup_name)
@@ -14285,6 +14295,8 @@ ada_get_symbol_name_matcher (const lookup_name_info &lookup_name)
     {
       if (lookup_name.ada ().wild_match_p ())
 	return do_wild_match;
+      else if (lookup_name.ada ().verbatim_p ())
+	return do_exact_match;
       else
 	return do_full_match;
     }

gdb/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2019-02-17  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/big_packed_array: New testcase.
+	* gdb.ada/homonym.exp: Fix incorrect expected output for
+	"break <homonym__get_value>" test.
+
 2019-02-13  Weimin Pan  <weimin.pan@oracle.com>
 
 	PR breakpoints/21870

gdb/testsuite/gdb.ada/big_packed_array.exp

@@ -0,0 +1,35 @@
+# Copyright 2019 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/>.
+
+load_lib "ada.exp"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile foo_ra24_010
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb]
+runto "foo_ra24_010.adb:$bp_location"
+
+gdb_test "print good" \
+         "= \\(false <repeats 196 times>\\)" \
+
+gdb_test "print bad" \
+         "= \\(false <repeats 196 times>\\)" \

gdb/testsuite/gdb.ada/big_packed_array/foo_ra24_010.adb

@@ -0,0 +1,24 @@
+--  Copyright 2019 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;
+
+procedure Foo_RA24_010 is
+   Good : PA := (others => False);
+   Bad : Bad_Packed_Table := (others => False);
+begin
+   Do_Nothing (Good'Address);  -- STOP
+   Do_Nothing (Bad'Address);
+end Foo_RA24_010;

gdb/testsuite/gdb.ada/big_packed_array/pck.adb

@@ -0,0 +1,21 @@
+--  Copyright 2019 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 Pck is
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;

gdb/testsuite/gdb.ada/big_packed_array/pck.ads

@@ -0,0 +1,53 @@
+--  Copyright 2019 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 System;
+
+package Pck is
+   type Enum_Idx is
+      (e_000, e_001, e_002, e_003, e_004, e_005, e_006, e_007, e_008,
+       e_009, e_010, e_011, e_012, e_013, e_014, e_015, e_016, e_017,
+       e_018, e_019, e_020, e_021, e_022, e_023, e_024, e_025, e_026,
+       e_027, e_028, e_029, e_030, e_031, e_032, e_033, e_034, e_035,
+       e_036, e_037, e_038, e_039, e_040, e_041, e_042, e_043, e_044,
+       e_045, e_046, e_047, e_048, e_049, e_050, e_051, e_052, e_053,
+       e_054, e_055, e_056, e_057, e_058, e_059, e_060, e_061, e_062,
+       e_063, e_064, e_065, e_066, e_067, e_068, e_069, e_070, e_071,
+       e_072, e_073, e_074, e_075, e_076, e_077, e_078, e_079, e_080,
+       e_081, e_082, e_083, e_084, e_085, e_086, e_087, e_088, e_089,
+       e_090, e_091, e_092, e_093, e_094, e_095, e_096, e_097, e_098,
+       e_099, e_100, e_101, e_102, e_103, e_104, e_105, e_106, e_107,
+       e_108, e_109, e_110, e_111, e_112, e_113, e_114, e_115, e_116,
+       e_117, e_118, e_119, e_120, e_121, e_122, e_123, e_124, e_125,
+       e_126, e_127, e_128, e_129, e_130, e_131, e_132, e_133, e_134,
+       e_135, e_136, e_137, e_138, e_139, e_140, e_141, e_142, e_143,
+       e_144, e_145, e_146, e_147, e_148, e_149, e_150, e_151, e_152,
+       e_153, e_154, e_155, e_156, e_157, e_158, e_159, e_160, e_161,
+       e_162, e_163, e_164, e_165, e_166, e_167, e_168, e_169, e_170,
+       e_171, e_172, e_173, e_174, e_175, e_176, e_177, e_178, e_179,
+       e_180, e_181, e_182, e_183, e_184, e_185, e_186, e_187, e_188,
+       e_189, e_190, e_191, e_192, e_193, e_194, e_195);
+
+   type PA is array (Enum_Idx) of Boolean;
+   pragma Pack (PA);
+
+   type T is array (Enum_Idx) of Boolean;
+   pragma Pack (T);
+   T_Empty : constant T := (others => False);
+
+   type Bad_Packed_Table is new T;
+
+   Procedure Do_Nothing (A : System.Address);
+end Pck;

gdb/testsuite/gdb.ada/homonym.exp

@@ -36,7 +36,7 @@ gdb_test "break homonym.adb:Get_Value" \
     "set breakpoint at homonym.adb:Get_Value"
 
 gdb_test "break <homonym__get_value>" \
-    "Breakpoint \[0-9\]+ at $hex: <homonym__get_value>. .2 locations." \
+    "Breakpoint \[0-9\]+ at $hex: file .*homonym\\.adb, line $decimal\\." \
     "set breakpoint at <homonym__get_value>"
 
 delete_breakpoints