[PATCH 6/8] (Ada) slightly incorrect bounds for type of array indexed by enum

[PATCH 6/8] (Ada) slightly incorrect bounds for type of array indexed by enum

[Joel Brobecker]

Consider the following code:

   type Enumerated is (Enum_A, Enum_B, Enum_C, Enum_Last);
   type Table is array (Enumerated) of Integer;
   --  Declare a variable of type Table to make sure the compiler
   --  does emit the debugging information for that type.
   V : Table := (others => 1);

Trying to print the type description of type Table, or of variable V
yields:

    (gdb) ptype v
    type = array (0 .. 3) of integer
    (gdb) ptype example.table
    type = array (0 .. 3) of integer

The compiler generates an XA type for the bounds...

 <1><cf6>: Abbrev Number: 13 (DW_TAG_structure_type)
    <cf7>   DW_AT_name        : example__table___XA

... whose member is described as being as:

 <2><cfe>: Abbrev Number: 14 (DW_TAG_member)
    <cff>   DW_AT_name        : example__enumerated
    <d05>   DW_AT_type        : <0xc69>

This leads us to DIE 0xc69, which is our enumeration type:

 <2><c69>: Abbrev Number: 4 (DW_TAG_enumeration_type)
    <c6a>   DW_AT_name        : example__enumerated

Normally, for arrays, we expect a range type, rather than an enumerated
type. However, for a situation like this, where the range of the array
index is the full enumeration type, it seems like a waste to require
an extra range layer.

Instead, looking at print_range, we see that we print the bounds
of our range using the target type:

       target_type = TYPE_TARGET_TYPE (type);
       if (target_type == NULL)
         target_type = type;
       [...]
       ada_print_scalar (target_type, lo, stream);
       fprintf_filtered (stream, " .. ");
       ada_print_scalar (target_type, hi, stream);

In this case, this causes us to use the enumerated type's subtype,
which is a plain integer type, hence the output we get. However,
there is no reason for using the target type, even in the TYPE_CODE_RANGE
situation. So this patch fixes the issue by simply printing the bounds
using the type being given, instead of its target type.

gdb/ChangeLog:

        * ada-typeprint.c (print_range): Print the bounds using TYPE
        rather than its TYPE_TARGET_TYPE.

A new test for this isn't necessary, as existing tests will demonstrate
this issue once a change in the compiler triggering the generation of
this type of debugging info gets pushed.
---
 gdb/ChangeLog       | 5 +++++
 gdb/ada-typeprint.c | 9 ++-------
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 7869bc1..0f73a3e 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,10 @@
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-typeprint.c (print_range): Print the bounds using TYPE
+	rather than its TYPE_TARGET_TYPE.
+
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
 	* ada-lang.c (ada_to_fixed_value): Minor reformatting in
 	call to ada_to_fixed_value_create.
 
diff --git a/gdb/ada-typeprint.c b/gdb/ada-typeprint.c
index 47ce897..b78654d 100644
--- a/gdb/ada-typeprint.c
+++ b/gdb/ada-typeprint.c
@@ -159,14 +159,9 @@ print_range (struct type *type, struct ui_file *stream,
     case TYPE_CODE_RANGE:
     case TYPE_CODE_ENUM:
       {
-	struct type *target_type;
 	LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
 	int got_error = 0;
 
-	target_type = TYPE_TARGET_TYPE (type);
-	if (target_type == NULL)
-	  target_type = type;
-
 	TRY
 	  {
 	    lo = ada_discrete_type_low_bound (type);
@@ -186,9 +181,9 @@ print_range (struct type *type, struct ui_file *stream,
 
 	if (!got_error)
 	  {
-	    ada_print_scalar (target_type, lo, stream);
+	    ada_print_scalar (type, lo, stream);
 	    fprintf_filtered (stream, " .. ");
-	    ada_print_scalar (target_type, hi, stream);
+	    ada_print_scalar (type, hi, stream);
 	  }
       }
       break;
-- 
2.1.4

[PATCH 3/8] (Ada) "catch assert" spurious internal error

[Joel Brobecker]

We noticed while debugging a program compiled without assertions
enabled and using an older compiler that inserting a catchpoint
on failed assertions would cause an internal error:

    (gdb) catch assert
    ../../src/gdb/ada-lang.c:13321: internal-error: ada_exception_sal:
    Assertion`sym != NULL' failed.
    A problem internal to GDB has been detected,

This is due to a combination of factors:

  1. With older versions of the compiler, the function used as a hook
     was provided by a unit that's different from the unit which
     provides the hooks for the other exception catchpoints.

  2. The program either does not use any assertion, or is compiled
     without the assertions enabled.

With newer versions of the compiler, all such functions are provided
by the same unit, so should normally always be available.  However,
there can still be reasons why this is not the case. Consider, for
instance, the case of a runtime compiled with -ffunction-sections,
in which case the hook might be eliminated unless assertions are
used and enabled.

So this patch transforms the internal error into a simple error.

gdb/ChangeLog:

        * ada-lang.c (ada_exception_sal): Replace gdb_assert calls
        by calls to error.

No testcase added, as the existing testcase gdb.ada/catch_ex.exp
should trigger it when using an older version of GNAT as the Ada
compiler.
---
 gdb/ChangeLog  |  5 +++++
 gdb/ada-lang.c | 13 +++++--------
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 41dee6e..4aeb0ba 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,10 @@
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-lang.c (ada_exception_sal): Replace gdb_assert calls
+	by calls to error.
+
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
 	* ada-lang.c (ada_unhandled_exception_name_addr_from_raise):
 	Move update of loop variable "fi".
 
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 87ae275..c5cddd0 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -13215,14 +13215,11 @@ ada_exception_sal (enum ada_exception_catchpoint_kind ex,
   sym_name = ada_exception_sym_name (ex);
   sym = standard_lookup (sym_name, NULL, VAR_DOMAIN);
 
-  /* We can assume that SYM is not NULL at this stage.  If the symbol
-     did not exist, ada_exception_support_info_sniffer would have
-     raised an exception.
-
-     Also, ada_exception_support_info_sniffer should have already
-     verified that SYM is a function symbol.  */
-  gdb_assert (sym != NULL);
-  gdb_assert (SYMBOL_CLASS (sym) == LOC_BLOCK);
+  if (sym == NULL)
+    error (_("Catchpoint symbol not found: %s"), sym_name);
+
+  if (SYMBOL_CLASS (sym) != LOC_BLOCK)
+    error (_("Unable to insert catchpoint. %s is not a function."), sym_name);
 
   /* Set ADDR_STRING.  */
   *addr_string = xstrdup (sym_name);
-- 
2.1.4

[PATCH 4/8] Handle PPC64 function descriptor in Ada decoding

[Joel Brobecker]

From: Jerome Guitton <guitton@adacore.com>

On PPC64, the entry point of the function "FN" is ".FN" when a function
descriptor is used. One of the consequences of this is that GDB then
presents the name of the function to the user (eg: in backtraces) with
the leading dot, which is a low-level internal detail that the user
should not be seeing.  The Ada decoding should strip it.

gdb/ChangeLog:

	* ada-lang.c (ada_decode): strip dot prefix in symbol name.

No testcase added, as a number of existing testcases should already
demonstrate that problem.
---
 gdb/ChangeLog  | 4 ++++
 gdb/ada-lang.c | 5 +++++
 2 files changed, 9 insertions(+)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 4aeb0ba..41b1ad4 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,7 @@
+2018-09-08  Jerome Guitton  <guitton@adacore.com>
+
+	* ada-lang.c (ada_decode): strip dot prefix in symbol name.
+
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
 	* ada-lang.c (ada_exception_sal): Replace gdb_assert calls
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index c5cddd0..16c7c51 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -1164,6 +1164,11 @@ ada_decode (const char *encoded)
   static char *decoding_buffer = NULL;
   static size_t decoding_buffer_size = 0;
 
+  /* With function descriptors on PPC64, the value of a symbol named
+     ".FN", if it exists, is the entry point of the function "FN".  */
+  if (encoded[0] == '.')
+    encoded += 1;
+
   /* The name of the Ada main procedure starts with "_ada_".
      This prefix is not part of the decoded name, so skip this part
      if we see this prefix.  */
-- 
2.1.4

[PATCH 1/8] (Ada) assigning packed array aggregate with variable as component

[Joel Brobecker]

Consider a variable "PRA" defined as a packed array of packed
records as follow:

   subtype Int is Integer range 0 .. 7;
   type Packed_Rec is record
      X, Y : Int;
      W    : Integer;
   end record;
   pragma Pack (Packed_Rec);
   type Packed_RecArr is array (Integer range <>) of Packed_Rec;
   pragma Pack (Packed_RecArr);

   PRA : Packed_RecArr (1 .. 3);

Consider also a variable "PR", which is a Packed_Rec record,
declared as follow:

   PR : Packed_Rec := (2, 2, 2);

Trying to assign a new value to PRA using an aggregate expression
where one of the components is our variable PR yields the wrong
result on big-endian machines (e.g. on ppc-linux):

    (gdb) p pra := (pr, (2,2,2), (2,2,2))
    $6 = ((x => 1, y => 0, w => 8), [...]

On the other hand, replacing "pr" by "(2,2,2)" does work.

I tracked the issue down to the bit offset we use to extract
the value of "PR" and copy it inside PRA. in value_assign_to_component,
we have:

  if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
    move_bits ([target buffer], [bit offset in target buffer],
               [source buffer where PR is stored],
               TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits,
               bits, 1);

The issue is with the third-to-last argument, which provides the bit
offset where the value of PR is stored relative to its start address,
and therefore the bit offset relative to the start of the source
buffer passed as the previous argument.

In our case, component is a 38bit packed record whose TYPE_LENGTH
is 5 bytes, so the bit-offset that gets calculated is 2 (bits).
However, that formula only really applies to scalars, whereas
in our case, we have a record (struct). The offset in the non-scalar
case should be zero.

gdb/ChangeLog:

        * ada-lang.c (value_assign_to_component): In the case of
        big-endian targets, extract the bits of the given VAL
        using an src_offset of zero if container is not a scalar.

gdb/testsuite/ChangeLog:

        * gdb.ada/packed_array_assign: New testcase.
---
 gdb/ChangeLog                                      |  6 ++++
 gdb/ada-lang.c                                     | 17 +++++++----
 gdb/testsuite/ChangeLog                            |  4 +++
 gdb/testsuite/gdb.ada/packed_array_assign.exp      | 30 ++++++++++++++++++++
 .../gdb.ada/packed_array_assign/aggregates.adb     | 25 ++++++++++++++++
 .../gdb.ada/packed_array_assign/aggregates.ads     | 33 ++++++++++++++++++++++
 gdb/testsuite/gdb.ada/packed_array_assign/pck.adb  | 23 +++++++++++++++
 gdb/testsuite/gdb.ada/packed_array_assign/pck.ads  | 22 +++++++++++++++
 .../gdb.ada/packed_array_assign/tester.adb         | 20 +++++++++++++
 9 files changed, 175 insertions(+), 5 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/packed_array_assign.exp
 create mode 100644 gdb/testsuite/gdb.ada/packed_array_assign/aggregates.adb
 create mode 100644 gdb/testsuite/gdb.ada/packed_array_assign/aggregates.ads
 create mode 100644 gdb/testsuite/gdb.ada/packed_array_assign/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/packed_array_assign/pck.ads
 create mode 100644 gdb/testsuite/gdb.ada/packed_array_assign/tester.adb

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index e6f44a3..0d87f83 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-lang.c (value_assign_to_component): In the case of
+	big-endian targets, extract the bits of the given VAL
+	using an src_offset of zero if container is not a scalar.
+
 2018-09-06  Simon Ser  <contact@emersion.fr>
 
 	PR gdb/23105
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index ef87164..3618e1d 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2809,11 +2809,18 @@ value_assign_to_component (struct value *container, struct value *component,
     bits = value_bitsize (component);
 
   if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
-    move_bits (value_contents_writeable (container) + offset_in_container,
-	       value_bitpos (container) + bit_offset_in_container,
-	       value_contents (val),
-	       TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits,
-	       bits, 1);
+    {
+      int src_offset;
+
+      if (is_scalar_type (check_typedef (value_type (component))))
+        src_offset
+	  = TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits;
+      else
+	src_offset = 0;
+      move_bits (value_contents_writeable (container) + offset_in_container,
+		 value_bitpos (container) + bit_offset_in_container,
+		 value_contents (val), src_offset, bits, 1);
+    }
   else
     move_bits (value_contents_writeable (container) + offset_in_container,
 	       value_bitpos (container) + bit_offset_in_container,
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index d808d8b..e667471 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/packed_array_assign: New testcase.
+
 2018-09-07  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* gdb.base/watchpoint.exp (test_complex_watchpoint): Extend test
diff --git a/gdb/testsuite/gdb.ada/packed_array_assign.exp b/gdb/testsuite/gdb.ada/packed_array_assign.exp
new file mode 100644
index 0000000..25b20dd
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_array_assign.exp
@@ -0,0 +1,30 @@
+# Copyright 2018 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"
+
+standard_ada_testfile tester
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
+  return -1
+}
+
+clean_restart ${testfile}
+
+runto "aggregates.run_test"
+
+gdb_test \
+    "print pra := ((x => 2, y => 0, w => 17), pr, (x => 7, y => 1, w => 23))" \
+    " = \\(\\(w => 17, x => 2, y => 0\\), \\(w => 104, x => 2, y => 3\\), \\(w => 23, x => 7, y => 1\\)\\)"
diff --git a/gdb/testsuite/gdb.ada/packed_array_assign/aggregates.adb b/gdb/testsuite/gdb.ada/packed_array_assign/aggregates.adb
new file mode 100644
index 0000000..c44bc0e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_array_assign/aggregates.adb
@@ -0,0 +1,25 @@
+--  Copyright 2018 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 body Aggregates is
+   procedure Run_Test is
+   begin
+      --  Fake the use of PRA to prevent the AIX linker from optimizing
+      --  the following symbols away.
+      Do_Nothing (PRA'Address);
+   end;
+end Aggregates;
diff --git a/gdb/testsuite/gdb.ada/packed_array_assign/aggregates.ads b/gdb/testsuite/gdb.ada/packed_array_assign/aggregates.ads
new file mode 100644
index 0000000..b43f70a
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_array_assign/aggregates.ads
@@ -0,0 +1,33 @@
+--  Copyright 2018 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 Aggregates is
+   subtype Int is Integer range 0 .. 7;
+
+   type Packed_Rec is record
+      X, Y : Int;
+      W    : Integer;
+   end record;
+   pragma Pack (Packed_Rec);
+
+   type Packed_RecArr is array (Integer range <>) of Packed_Rec;
+   pragma Pack (Packed_RecArr);
+
+   procedure Run_Test;
+
+private
+   PR : Packed_Rec := (y => 3, w => 104, x => 2);
+   PRA : Packed_RecArr (1 .. 3);
+end Aggregates;
diff --git a/gdb/testsuite/gdb.ada/packed_array_assign/pck.adb b/gdb/testsuite/gdb.ada/packed_array_assign/pck.adb
new file mode 100644
index 0000000..3b03c00
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_array_assign/pck.adb
@@ -0,0 +1,23 @@
+--  Copyright 2018 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;
diff --git a/gdb/testsuite/gdb.ada/packed_array_assign/pck.ads b/gdb/testsuite/gdb.ada/packed_array_assign/pck.ads
new file mode 100644
index 0000000..c3400c2
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_array_assign/pck.ads
@@ -0,0 +1,22 @@
+--  Copyright 2018 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
+
+   procedure Do_Nothing (A : System.Address);
+
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/packed_array_assign/tester.adb b/gdb/testsuite/gdb.ada/packed_array_assign/tester.adb
new file mode 100644
index 0000000..dd61509
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_array_assign/tester.adb
@@ -0,0 +1,20 @@
+--  Copyright 2018 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 Aggregates;
+procedure Tester is
+begin
+   Aggregates.Run_Test;
+end Tester;
-- 
2.1.4

[PATCH 8/8] (Ada) fix handling of expression with parameterless function call

[Joel Brobecker]

Consider the following function, which takes no parameter and returns
an integer:

    function Something return Integer;

For the purpose of this discussion, our function has been implemented
to always return 124:

    function Something return Integer is
    begin
       return 124;
    end Something;

In Ada, such function can been called without using the parentheses.
For instance, in the statement below, variable My_Value is assigned
the returned value from the call to Something:

    My_Value := Something;

The Ada expression interpeter in GDB supports this case, as we can
see below:

    (gdb) print something
    $1 = 124

However, we get fairly strange results when trying to use this feature
as part of a larger expression. For instance:

    (gdb) print something + 1
    $2 = 248

The problem occurs while doing the resolution pass of the expression.
After prefixying the expression, we obtain the following expression:

    0  BINOP_ADD
    1    OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
    5    OP_LONG               Type @0x1e3c170 (int), value 1 (0x1)

The resolution pass is then expected to remove the OP_VAR_VALUE
entry, and replace it with an OP_FUNCALL. This is what the call
to replace_operator_with_call in ada-lang.c::resolve_subexp is
expected to do:

      if (deprocedure_p
          && (TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol))
              == TYPE_CODE_FUNC))
        {
          replace_operator_with_call (expp, pc, 0, 0,
                                      exp->elts[pc + 2].symbol,
                                      exp->elts[pc + 1].block);
          exp = expp->get ();
        }

The problem is that we're passing OPLEN (zero -- 4th parameter in
the call), and so replace_operator_with_call ends up removing zero
element from our expression, and inserting the corresponding OP_FUNCALL
instead. As a result, instead of having the OP_LONG (1) as the second
argument of the BINOP_ADD, it is now the OP_VAR_VALUE that we were
meant to replace. That OP_VAR_VALUE then itself gets transformed into
an OP_FUNCALL, with the same issue, and eventually, the resolved
expression now looks like this:

     0  BINOP_ADD
     1    OP_FUNCALL            Number of args: 0
     4      OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
     8    OP_FUNCALL            Number of args: 0
    11      OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
    15  OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
    19  OP_LONG               Type @0x1e3c170 (int), value 1 (0x1)

This explains why we get twice the result of the function call
instead of its value plus one. The extra entries in the expression
at the end are just ignored.

This patch fixes the issue by calling replace_operator_with_call
with the correct OPLEN equal to the size of an OP_VAR_VALUE (4).

gdb/ChangeLog:

        * ada-lang.c (resolve_subexp): Pass correct OPLEN in call to
        replace_operator_with_call.

gdb/testsuite/ChangeLog:

        * gdb.ada/expr_with_funcall: New testcase.
---
 gdb/ChangeLog                                      |  5 +++
 gdb/ada-lang.c                                     |  2 +-
 gdb/testsuite/ChangeLog                            |  4 ++
 gdb/testsuite/gdb.ada/expr_with_funcall.exp        | 52 ++++++++++++++++++++++
 .../gdb.ada/expr_with_funcall/expr_r821_013.adb    | 23 ++++++++++
 gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb    | 26 +++++++++++
 gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads    | 20 +++++++++
 7 files changed, 131 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.ada/expr_with_funcall.exp
 create mode 100644 gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb
 create mode 100644 gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index c3527dc..3247b66 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,10 @@
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-lang.c (resolve_subexp): Pass correct OPLEN in call to
+	replace_operator_with_call.
+
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
 	* ada-lang.c (ada_value_cast): Remove unnecessary parentheses.
 
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 0a73ca4..b8a11cd 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -3515,7 +3515,7 @@ resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
           && (TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol))
               == TYPE_CODE_FUNC))
         {
-          replace_operator_with_call (expp, pc, 0, 0,
+          replace_operator_with_call (expp, pc, 0, 4,
                                       exp->elts[pc + 2].symbol,
                                       exp->elts[pc + 1].block);
           exp = expp->get ();
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index e667471..02da57f 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
+	* gdb.ada/expr_with_funcall: New testcase.
+
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
 	* gdb.ada/packed_array_assign: New testcase.
 
 2018-09-07  Andrew Burgess  <andrew.burgess@embecosm.com>
diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall.exp b/gdb/testsuite/gdb.ada/expr_with_funcall.exp
new file mode 100644
index 0000000..77ad658
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall.exp
@@ -0,0 +1,52 @@
+# Copyright 2018 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"
+
+standard_ada_testfile expr_r821_013
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/expr_r821_013.adb]
+runto "expr_r821_013.adb:$bp_location"
+
+gdb_test "print something()"     " = 124"
+gdb_test "print something() + 1" " = 125"
+gdb_test "print something() - 2" " = 122"
+gdb_test "print something() * 3" " = 372"
+gdb_test "print something() / 4" " = 31"
+
+gdb_test "print 1 + something()"   " = 125"
+gdb_test "print 246 - something()" " = 122"
+gdb_test "print 3 * something()"   " = 372"
+gdb_test "print 496 / something()" " = 4"
+
+# Same as above, but without using the parentheses in the call to
+# function "Something".
+
+gdb_test "print something"     " = 124"
+gdb_test "print something + 1" " = 125"
+gdb_test "print something - 2" " = 122"
+gdb_test "print something * 3" " = 372"
+gdb_test "print something / 4" " = 31"
+
+gdb_test "print 1 + something"   " = 125"
+gdb_test "print 246 - something" " = 122"
+gdb_test "print 3 * something"   " = 372"
+gdb_test "print 496 / something" " = 4"
diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb b/gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb
new file mode 100644
index 0000000..98e9f2e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb
@@ -0,0 +1,23 @@
+--  Copyright 2018 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 Expr_R821_013 is
+   Val : Integer := Something;
+begin
+   Do_Nothing (Val'Address); -- STOP
+end Expr_R821_013;
+
diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb b/gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb
new file mode 100644
index 0000000..901b8db
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb
@@ -0,0 +1,26 @@
+--  Copyright 2018 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
+   function Something return Integer is
+   begin
+      return 124;
+   end Something;
+
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads b/gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads
new file mode 100644
index 0000000..53cbe52
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads
@@ -0,0 +1,20 @@
+--  Copyright 2018 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
+   function Something return Integer;
+   procedure Do_Nothing (A : System.Address);
+end Pck;
-- 
2.1.4

[PATCH 2/8] (Ada) infinite loop when hitting unhandled exception catchpoint

[Joel Brobecker]

When debugging a program compiled with an older version of GNAT,
hitting a catchpoint on unhandled exceptions can caused GDB to
got into an infinite loop. This happens while trying to find
the name of the exception that was raised. For that, it searches
for a frame corresponding to a specific function we know gets
called during the exeption handling.

In our particular case, the compiler was too old, and so GDB never
found that frame, and eventually got past the "main" subprogram,
all the way to system frames, where no symbol was available.
As a result, the code addresses could not be resolved into
a function name, leading to the infinite loop because of
a misplaced update of our loop variable "fi":

    while (fi != NULL)
      {
        char *func_name;
        enum language func_lang;

        find_frame_funname (fi, &func_name, &func_lang, NULL);
        if (func_name != NULL)
          {
            make_cleanup (xfree, func_name);

            if (strcmp (func_name,
                        data->exception_info->catch_exception_sym) == 0)
              break; /* We found the frame we were looking for...  */
            fi = get_prev_frame (fi);
          }
      }

If FUNC_NAME is NULL, then FI never gets updated ever after!

gdb/ChangeLog:

        * ada-lang.c (ada_unhandled_exception_name_addr_from_raise):
        Move update of loop variable "fi".

No testcase added, as the existing testcase gdb.ada/catch_ex.exp
should trigger it when using an older version of GNAT as the Ada
compiler.
---
 gdb/ChangeLog  | 5 +++++
 gdb/ada-lang.c | 2 +-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0d87f83..41dee6e 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,10 @@
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-lang.c (ada_unhandled_exception_name_addr_from_raise):
+	Move update of loop variable "fi".
+
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
 	* ada-lang.c (value_assign_to_component): In the case of
 	big-endian targets, extract the bits of the given VAL
 	using an src_offset of zero if container is not a scalar.
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 3618e1d..87ae275 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -12242,8 +12242,8 @@ ada_unhandled_exception_name_addr_from_raise (void)
           if (strcmp (func_name.get (),
 		      data->exception_info->catch_exception_sym) == 0)
 	    break; /* We found the frame we were looking for...  */
-	  fi = get_prev_frame (fi);
 	}
+      fi = get_prev_frame (fi);
     }
 
   if (fi == NULL)
-- 
2.1.4

Various fixes in ada-lang.c

[Joel Brobecker]

Hello,

FYI, I am about to push the following fixes we made in the AdaCore
version of GDB.

  - [PATCH 1/8] (Ada) assigning packed array aggregate with variable as
  - [PATCH 2/8] (Ada) infinite loop when hitting unhandled exception
  - [PATCH 3/8] (Ada) "catch assert" spurious internal error
  - [PATCH 4/8] Handle PPC64 function descriptor in Ada decoding
  - [PATCH 5/8] minor reformatting in ada-lang.c::ada_to_fixed_value
  - [PATCH 6/8] (Ada) slightly incorrect bounds for type of array indexed
  - [PATCH 7/8] ada-lang.c::ada_value_cast: remove unnecessary
  - [PATCH 8/8] (Ada) fix handling of expression with parameterless

All patches were re-validated on x86_64-linux, except for the PPC64
one which was validated on ppc64-linux (with the later being done
using AdaCore's testsuite).

Thank you,
-- 
Joel

[PATCH 7/8] ada-lang.c::ada_value_cast: remove unnecessary parentheses

[Joel Brobecker]

No other code change.

gdb/ChangeLog:

        * ada-lang.c (ada_value_cast): Remove unnecessary parentheses.
---
 gdb/ChangeLog  | 4 ++++
 gdb/ada-lang.c | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0f73a3e..c3527dc 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,9 @@
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-lang.c (ada_value_cast): Remove unnecessary parentheses.
+
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
 	* ada-typeprint.c (print_range): Print the bounds using TYPE
 	rather than its TYPE_TARGET_TYPE.
 
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index b370b3c..0a73ca4 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -10233,7 +10233,7 @@ ada_value_cast (struct type *type, struct value *arg2)
     return arg2;
 
   if (ada_is_fixed_point_type (type))
-    return (cast_to_fixed (type, arg2));
+    return cast_to_fixed (type, arg2);
 
   if (ada_is_fixed_point_type (value_type (arg2)))
     return cast_from_fixed (type, arg2);
-- 
2.1.4

[PATCH 5/8] minor reformatting in ada-lang.c::ada_to_fixed_value

[Joel Brobecker]

The arguments in the call to ada_to_fixed_value_create where
improperly aligned. But I also noticed that all the arguments
do fit on a single-line (up to 79 characters). So this patch
just fixes the code by putting everything on that same line.

gdb/ChangeLog:

        * ada-lang.c (ada_to_fixed_value): Minor reformatting in
        call to ada_to_fixed_value_create.
---
 gdb/ChangeLog  | 5 +++++
 gdb/ada-lang.c | 4 +---
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 41b1ad4..7869bc1 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,8 @@
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-lang.c (ada_to_fixed_value): Minor reformatting in
+	call to ada_to_fixed_value_create.
+
 2018-09-08  Jerome Guitton  <guitton@adacore.com>
 
 	* ada-lang.c (ada_decode): strip dot prefix in symbol name.
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 16c7c51..b370b3c 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -9312,9 +9312,7 @@ struct value *
 ada_to_fixed_value (struct value *val)
 {
   val = unwrap_value (val);
-  val = ada_to_fixed_value_create (value_type (val),
-				      value_address (val),
-				      val);
+  val = ada_to_fixed_value_create (value_type (val), value_address (val), val);
   return val;
 }
 \f
-- 
2.1.4