[PATCH 0/4] Some wide string improvements for Ada

[PATCH 0/4] Some wide string improvements for Ada

[Tom Tromey]

This series implements a couple of wide string improvements for Ada.

First, a string literal in an expression can now sometimes be
interpreted as a Wide_String or Wide_Wide_String, depending on
context.

Then, we noticed that string concatenation did not work for Ada, so
this series implemens that as well.  Additionally, this removes some
dead code and fixes array concatenation for D.

Tested on x86-64 Fedora 34.

Tom

[PATCH 1/4] Remove eval_op_string

[Tom Tromey]

eval_op_string is only used in a single place -- the implementation of
string_operation.  This patch turns it into the
string_operation::evaluate method, removing a bit of extraneous code.
---
 gdb/eval.c  | 15 ++++++++++-----
 gdb/expop.h | 11 +----------
 2 files changed, 11 insertions(+), 15 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index 6ced0b261e7..b7b8915fa89 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1078,17 +1078,22 @@ eval_op_register (struct type *expect_type, struct expression *exp,
     return val;
 }
 
-/* Helper function that implements the body of OP_STRING.  */
+namespace expr
+{
 
-struct value *
-eval_op_string (struct type *expect_type, struct expression *exp,
-		enum noside noside, int len, const char *string)
+value *
+string_operation::evaluate (struct type *expect_type,
+			    struct expression *exp,
+			    enum noside noside)
 {
+  const std::string &str = std::get<0> (m_storage);
   struct type *type = language_string_char_type (exp->language_defn,
 						 exp->gdbarch);
-  return value_string (string, len, type);
+  return value_string (str.c_str (), str.size (), type);
 }
 
+} /* namespace expr */
+
 /* Helper function that implements the body of OP_OBJC_SELECTOR.  */
 
 struct value *
diff --git a/gdb/expop.h b/gdb/expop.h
index 58863b8f3ab..1592568a857 100644
--- a/gdb/expop.h
+++ b/gdb/expop.h
@@ -64,10 +64,6 @@ extern struct value *eval_op_func_static_var (struct type *expect_type,
 extern struct value *eval_op_register (struct type *expect_type,
 				       struct expression *exp,
 				       enum noside noside, const char *name);
-extern struct value *eval_op_string (struct type *expect_type,
-				     struct expression *exp,
-				     enum noside noside, int len,
-				     const char *string);
 extern struct value *eval_op_ternop (struct type *expect_type,
 				     struct expression *exp,
 				     enum noside noside,
@@ -912,12 +908,7 @@ class string_operation
 
   value *evaluate (struct type *expect_type,
 		   struct expression *exp,
-		   enum noside noside) override
-  {
-    const std::string &str = std::get<0> (m_storage);
-    return eval_op_string (expect_type, exp, noside,
-			   str.size (), str.c_str ());
-  }
+		   enum noside noside) override;
 
   enum exp_opcode opcode () const override
   { return OP_STRING; }
-- 
2.34.1

[PATCH 2/4] Ada support for wide strings

[Tom Tromey]

This adds some basic support for Wide_String and Wide_Wide_String to
the Ada expression evaluator.  In particular, a string literal may be
converted to a wide or wide-wide string depending on context.

The patch updates an existing test case.  Note that another test,
namely something like:

    ptype Wide_Wide_String'("literal")

... would be nice to add, but when tested against a distro GNAT, this
did not work (probably due to lack of debuginfo); so, I haven't
included it here.
---
 gdb/ada-lang.c                         | 63 +++++++++++++++++++++++---
 gdb/testsuite/gdb.ada/widewide.exp     |  4 ++
 gdb/testsuite/gdb.ada/widewide/foo.adb |  2 +
 3 files changed, 63 insertions(+), 6 deletions(-)

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 12ff0353829..f097ad4b6f7 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -10603,12 +10603,63 @@ ada_string_operation::evaluate (struct type *expect_type,
 				struct expression *exp,
 				enum noside noside)
 {
-  value *result = string_operation::evaluate (expect_type, exp, noside);
-  /* The result type will have code OP_STRING, bashed there from 
-     OP_ARRAY.  Bash it back.  */
-  if (value_type (result)->code () == TYPE_CODE_STRING)
-    value_type (result)->set_code (TYPE_CODE_ARRAY);
-  return result;
+  struct type *char_type;
+  if (expect_type != nullptr && ada_is_string_type (expect_type))
+    char_type = ada_array_element_type (expect_type, 1);
+  else
+    char_type = language_string_char_type (exp->language_defn, exp->gdbarch);
+
+  const std::string &str = std::get<0> (m_storage);
+  const char *encoding;
+  switch (TYPE_LENGTH (char_type))
+    {
+    case 1:
+      {
+	/* Simply copy over the data -- this isn't perhaps strictly
+	   correct according to the encodings, but it is gdb's
+	   historical behavior.  */
+	struct type *stringtype
+	  = lookup_array_range_type (char_type, 1, str.length ());
+	struct value *val = allocate_value (stringtype);
+	memcpy (value_contents_raw (val).data (), str.c_str (),
+		str.length ());
+	return val;
+      }
+
+    case 2:
+      if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
+	encoding = "UTF-16BE";
+      else
+	encoding = "UTF-16LE";
+      break;
+
+    case 4:
+      if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
+	encoding = "UTF-32BE";
+      else
+	encoding = "UTF-32LE";
+      break;
+
+    default:
+      error (_("unexpected character type size %s"),
+	     pulongest (TYPE_LENGTH (char_type)));
+    }
+
+  auto_obstack converted;
+  convert_between_encodings (host_charset (), encoding,
+			     (const gdb_byte *) str.c_str (),
+			     str.length (), 1,
+			     &converted, translit_none);
+
+  struct type *stringtype
+    = lookup_array_range_type (char_type, 1,
+			       obstack_object_size (&converted)
+			       / TYPE_LENGTH (char_type));
+  struct value *val = allocate_value (stringtype);
+  memcpy (value_contents_raw (val).data (),
+	  obstack_base (&converted),
+	  obstack_object_size (&converted));
+  return val;
 }
 
 value *
diff --git a/gdb/testsuite/gdb.ada/widewide.exp b/gdb/testsuite/gdb.ada/widewide.exp
index c0268f9c99b..d68a0b112c4 100644
--- a/gdb/testsuite/gdb.ada/widewide.exp
+++ b/gdb/testsuite/gdb.ada/widewide.exp
@@ -43,3 +43,7 @@ gdb_test "print my_wws(1)" "= 32 ' '"
 
 gdb_test "print my_wws(2)" "= 104 'h'"
 
+gdb_test "print my_wws = \" helo\"" " = true"
+
+gdb_test "print my_ws = \"wide\"" " = true"
+gdb_test "print my_ws = \"nope\"" " = false"
diff --git a/gdb/testsuite/gdb.ada/widewide/foo.adb b/gdb/testsuite/gdb.ada/widewide/foo.adb
index 45adbde20a1..d41734a485f 100644
--- a/gdb/testsuite/gdb.ada/widewide/foo.adb
+++ b/gdb/testsuite/gdb.ada/widewide/foo.adb
@@ -19,9 +19,11 @@ procedure Foo is
    Some_Easy : Wide_Wide_Character := 'J';
    Some_Larger : Wide_Wide_Character := Wide_Wide_Character'Val(16#beef#);
    Some_Big : Wide_Wide_Character := Wide_Wide_Character'Val(16#00dabeef#);
+   My_Ws : Wide_String := "wide";
    My_WWS : Wide_Wide_String := " helo";
 begin
    Do_Nothing (Some_Easy'Address);  -- START
    Do_Nothing (Some_Larger'Address);
+   Do_Nothing (My_Ws'Address);
    Do_Nothing (Some_Big'Address);
 end Foo;
-- 
2.34.1

[PATCH 3/4] Remove eval_op_concat

[Tom Tromey]

eval_op_concat has code to search for an operator overload of
BINOP_CONCAT.  However, the operator overloading code is specific to
C++, which does not have this operator.  And,
binop_types_user_defined_p rejects this case right at the start, and
value_x_binop does not handle this case.  I think this code has been
dead for a very long time.  This patch removes it and hoists the
remaining call into concatenation::evaluate, removing eval_op_concat
entirely.
---
 gdb/eval.c     | 12 ------------
 gdb/expop.h    |  6 +-----
 gdb/valarith.c |  2 +-
 3 files changed, 2 insertions(+), 18 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index b7b8915fa89..266a4f7699f 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1106,18 +1106,6 @@ eval_op_objc_selector (struct type *expect_type, struct expression *exp,
 			     lookup_child_selector (exp->gdbarch, sel));
 }
 
-/* Helper function that implements the body of BINOP_CONCAT.  */
-
-struct value *
-eval_op_concat (struct type *expect_type, struct expression *exp,
-		enum noside noside, struct value *arg1, struct value *arg2)
-{
-  if (binop_user_defined_p (BINOP_CONCAT, arg1, arg2))
-    return value_x_binop (arg1, arg2, BINOP_CONCAT, OP_NULL, noside);
-  else
-    return value_concat (arg1, arg2);
-}
-
 /* A helper function for TERNOP_SLICE.  */
 
 struct value *
diff --git a/gdb/expop.h b/gdb/expop.h
index 1592568a857..d903ab0bb7e 100644
--- a/gdb/expop.h
+++ b/gdb/expop.h
@@ -83,10 +83,6 @@ extern struct value *eval_op_member (struct type *expect_type,
 				     struct expression *exp,
 				     enum noside noside,
 				     struct value *arg1, struct value *arg2);
-extern struct value *eval_op_concat (struct type *expect_type,
-				     struct expression *exp,
-				     enum noside noside,
-				     struct value *arg1, struct value *arg2);
 extern struct value *eval_op_add (struct type *expect_type,
 				  struct expression *exp,
 				  enum noside noside,
@@ -1158,7 +1154,7 @@ class concat_operation
       = std::get<0> (m_storage)->evaluate_with_coercion (exp, noside);
     value *rhs
       = std::get<1> (m_storage)->evaluate_with_coercion (exp, noside);
-    return eval_op_concat (expect_type, exp, noside, lhs, rhs);
+    return value_concat (lhs, rhs);
   }
 
   enum exp_opcode opcode () const override
diff --git a/gdb/valarith.c b/gdb/valarith.c
index e13db10ab55..791c1cd9a06 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -252,7 +252,7 @@ int
 binop_types_user_defined_p (enum exp_opcode op,
 			    struct type *type1, struct type *type2)
 {
-  if (op == BINOP_ASSIGN || op == BINOP_CONCAT)
+  if (op == BINOP_ASSIGN)
     return 0;
 
   type1 = check_typedef (type1);
-- 
2.34.1

[PATCH 4/4] Reimplement array concatenation for Ada and D

[Tom Tromey]

This started as a patch to implement string concatenation for Ada.
However, while working on this, I looked at how this code could
possibly be called.  It turns out there are only two users of
concat_operation: Ada and D.  So, in addition to implementing this for
Ada, this patch rewrites value_concat, removing the odd "concatenate
or repeat" semantics, which were completely unused.  As Ada and D both
seem to represent strings using TYPE_CODE_ARRAY, this removes the
TYPE_CODE_STRING code from there as well.
---
 gdb/ada-exp.h                          |  15 +++
 gdb/ada-exp.y                          |   2 +-
 gdb/ada-lang.c                         |  58 ++++++++-
 gdb/doc/gdb.texinfo                    |   5 +-
 gdb/testsuite/gdb.ada/widewide.exp     |  12 ++
 gdb/testsuite/gdb.dlang/expression.exp |   4 +
 gdb/valarith.c                         | 169 ++++++-------------------
 7 files changed, 131 insertions(+), 134 deletions(-)

diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 765f0dca3c5..44ca2545670 100644
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -769,6 +769,21 @@ class ada_char_operation : public long_const_operation,
 			bool parse_completion,
 			innermost_block_tracker *tracker,
 			struct type *context_type) override;
+
+  value *evaluate (struct type *expect_type,
+		   struct expression *exp,
+		   enum noside noside) override;
+};
+
+class ada_concat_operation : public concat_operation
+{
+public:
+
+  using concat_operation::concat_operation;
+
+  value *evaluate (struct type *expect_type,
+		   struct expression *exp,
+		   enum noside noside) override;
 };
 
 } /* namespace expr */
diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index c974657dbcd..1f98f10f984 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -649,7 +649,7 @@ simple_exp	:	simple_exp '+' simple_exp
 	;
 
 simple_exp	:	simple_exp '&' simple_exp
-			{ ada_wrap2<concat_operation> (BINOP_CONCAT); }
+			{ ada_wrap2<ada_concat_operation> (BINOP_CONCAT); }
 	;
 
 simple_exp	:	simple_exp '-' simple_exp
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index f097ad4b6f7..0f772fd7b46 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -10552,6 +10552,17 @@ convert_char_literal (struct type *type, LONGEST val)
   return val;
 }
 
+value *
+ada_char_operation::evaluate (struct type *expect_type,
+			      struct expression *exp,
+			      enum noside noside)
+{
+  value *result = long_const_operation::evaluate (expect_type, exp, noside);
+  if (expect_type != nullptr)
+    result = ada_value_cast (expect_type, result);
+  return result;
+}
+
 /* See ada-exp.h.  */
 
 operation_up
@@ -10572,7 +10583,7 @@ ada_char_operation::replace (operation_up &&owner,
 	= convert_char_literal (context_type, std::get<1> (m_storage));
     }
 
-  return make_operation<ada_wrapped_operation> (std::move (result));
+  return result;
 }
 
 value *
@@ -10662,6 +10673,51 @@ ada_string_operation::evaluate (struct type *expect_type,
   return val;
 }
 
+value *
+ada_concat_operation::evaluate (struct type *expect_type,
+				struct expression *exp,
+				enum noside noside)
+{
+  /* If one side is a literal, evaluate the other side first so that
+     the expected type can be set properly.  */
+  const operation_up &lhs_expr = std::get<0> (m_storage);
+  const operation_up &rhs_expr = std::get<1> (m_storage);
+
+  value *lhs, *rhs;
+  if (dynamic_cast<ada_string_operation *> (lhs_expr.get ()) != nullptr)
+    {
+      rhs = rhs_expr->evaluate (nullptr, exp, noside);
+      lhs = lhs_expr->evaluate (value_type (rhs), exp, noside);
+    }
+  else if (dynamic_cast<ada_char_operation *> (lhs_expr.get ()) != nullptr)
+    {
+      rhs = rhs_expr->evaluate (nullptr, exp, noside);
+      struct type *rhs_type = check_typedef (value_type (rhs));
+      struct type *elt_type = nullptr;
+      if (rhs_type->code () == TYPE_CODE_ARRAY)
+	elt_type = TYPE_TARGET_TYPE (rhs_type);
+      lhs = lhs_expr->evaluate (elt_type, exp, noside);
+    }
+  else if (dynamic_cast<ada_string_operation *> (rhs_expr.get ()) != nullptr)
+    {
+      lhs = lhs_expr->evaluate (nullptr, exp, noside);
+      rhs = rhs_expr->evaluate (value_type (lhs), exp, noside);
+    }
+  else if (dynamic_cast<ada_char_operation *> (rhs_expr.get ()) != nullptr)
+    {
+      lhs = lhs_expr->evaluate (nullptr, exp, noside);
+      struct type *lhs_type = check_typedef (value_type (lhs));
+      struct type *elt_type = nullptr;
+      if (lhs_type->code () == TYPE_CODE_ARRAY)
+	elt_type = TYPE_TARGET_TYPE (lhs_type);
+      rhs = rhs_expr->evaluate (elt_type, exp, noside);
+    }
+  else
+    return concat_operation::evaluate (expect_type, exp, noside);
+
+  return value_concat (lhs, rhs);
+}
+
 value *
 ada_qual_operation::evaluate (struct type *expect_type,
 			      struct expression *exp,
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index d216fa1d529..729f9d79a93 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -18094,10 +18094,7 @@ operand of the membership (@code{in}) operator.
 @end itemize
 
 @item
-The names in
-@code{Characters.Latin_1} are not available and
-concatenation is not implemented.  Thus, escape characters in strings are 
-not currently available.
+The names in @code{Characters.Latin_1} are not available.
 
 @item
 Equality tests (@samp{=} and @samp{/=}) on arrays test for bitwise
diff --git a/gdb/testsuite/gdb.ada/widewide.exp b/gdb/testsuite/gdb.ada/widewide.exp
index d68a0b112c4..2f14a0faee8 100644
--- a/gdb/testsuite/gdb.ada/widewide.exp
+++ b/gdb/testsuite/gdb.ada/widewide.exp
@@ -47,3 +47,15 @@ gdb_test "print my_wws = \" helo\"" " = true"
 
 gdb_test "print my_ws = \"wide\"" " = true"
 gdb_test "print my_ws = \"nope\"" " = false"
+
+gdb_test "print \"x\" & my_ws & \"y\"" " = \"xwidey\""
+
+gdb_test "print my_wws(1..3) := \"abc\"" " = \"abc\""
+gdb_test "print my_wws" " = \"abclo\"" \
+    "print my_wws after slice assignment"
+gdb_test "print my_wws(1..3) := my_wws(2..4)" " = \"bcl\""
+gdb_test "print my_wws" " = \"bcllo\"" \
+    "print my_wws after overlapping slice assignment"
+
+gdb_test "print 'x' & my_ws" " = \"xwide\""
+gdb_test "print my_ws & 'y'" " = \"widey\""
diff --git a/gdb/testsuite/gdb.dlang/expression.exp b/gdb/testsuite/gdb.dlang/expression.exp
index 1ac6dca6248..6173dca713b 100644
--- a/gdb/testsuite/gdb.dlang/expression.exp
+++ b/gdb/testsuite/gdb.dlang/expression.exp
@@ -121,6 +121,10 @@ proc test_d_expressions {} {
 
     gdb_test_no_output "set \$var = 144 ^^ 0.5" ""
     gdb_test "print \$var ^^= 2" "144"
+
+    gdb_test "print 1 ~ \[2, 3\]" " = \\\{1, 2, 3\\\}"
+    gdb_test "print \[1, 2\] ~ 3" " = \\\{1, 2, 3\\\}"
+    gdb_test "print \[1, 2\] ~ \[2, 3\]" " = \\\{1, 2, 2, 3\\\}"
 }
 
 # Start with a fresh gdb.
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 791c1cd9a06..36d30f161f6 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -651,153 +651,66 @@ value_x_unop (struct value *arg1, enum exp_opcode op, enum noside noside)
 }
 \f
 
-/* Concatenate two values with the following conditions:
-
-   (1)  Both values must be either bitstring values or character string
-   values and the resulting value consists of the concatenation of
-   ARG1 followed by ARG2.
-
-   or
-
-   One value must be an integer value and the other value must be
-   either a bitstring value or character string value, which is
-   to be repeated by the number of times specified by the integer
-   value.
-
-
-   (2)  Boolean values are also allowed and are treated as bit string
-   values of length 1.
-
-   (3)  Character values are also allowed and are treated as character
-   string values of length 1.  */
+/* Concatenate two values.  One value must be an array; and the other
+   value must either be an array with the same element type, or be of
+   the array's element type.  */
 
 struct value *
 value_concat (struct value *arg1, struct value *arg2)
 {
-  struct value *inval1;
-  struct value *inval2;
-  struct value *outval = NULL;
-  int inval1len, inval2len;
-  int count, idx;
-  char inchar;
   struct type *type1 = check_typedef (value_type (arg1));
   struct type *type2 = check_typedef (value_type (arg2));
-  struct type *char_type;
 
-  /* First figure out if we are dealing with two values to be concatenated
-     or a repeat count and a value to be repeated.  INVAL1 is set to the
-     first of two concatenated values, or the repeat count.  INVAL2 is set
-     to the second of the two concatenated values or the value to be 
-     repeated.  */
+  if (type1->code () != TYPE_CODE_ARRAY && type2->code () != TYPE_CODE_ARRAY)
+    error ("no array provided to concatenation");
 
-  if (type2->code () == TYPE_CODE_INT)
+  LONGEST low1, high1;
+  struct type *elttype1 = type1;
+  if (elttype1->code () == TYPE_CODE_ARRAY)
     {
-      struct type *tmp = type1;
-
-      type1 = tmp;
-      tmp = type2;
-      inval1 = arg2;
-      inval2 = arg1;
+      elttype1 = TYPE_TARGET_TYPE (elttype1);
+      if (!get_array_bounds (type1, &low1, &high1))
+	error (_("could not determine array bounds on left-hand-side of "
+		 "array concatenation"));
     }
   else
     {
-      inval1 = arg1;
-      inval2 = arg2;
+      low1 = 0;
+      high1 = 0;
     }
 
-  /* Now process the input values.  */
-
-  if (type1->code () == TYPE_CODE_INT)
+  LONGEST low2, high2;
+  struct type *elttype2 = type2;
+  if (elttype2->code () == TYPE_CODE_ARRAY)
     {
-      /* We have a repeat count.  Validate the second value and then
-	 construct a value repeated that many times.  */
-      if (type2->code () == TYPE_CODE_STRING
-	  || type2->code () == TYPE_CODE_CHAR)
-	{
-	  count = longest_to_int (value_as_long (inval1));
-	  inval2len = TYPE_LENGTH (type2);
-	  std::vector<char> ptr (count * inval2len);
-	  if (type2->code () == TYPE_CODE_CHAR)
-	    {
-	      char_type = type2;
-
-	      inchar = (char) unpack_long (type2,
-					   value_contents (inval2).data ());
-	      for (idx = 0; idx < count; idx++)
-		{
-		  ptr[idx] = inchar;
-		}
-	    }
-	  else
-	    {
-	      char_type = TYPE_TARGET_TYPE (type2);
-
-	      for (idx = 0; idx < count; idx++)
-		memcpy (&ptr[idx * inval2len], value_contents (inval2).data (),
-			inval2len);
-	    }
-	  outval = value_string (ptr.data (), count * inval2len, char_type);
-	}
-      else if (type2->code () == TYPE_CODE_BOOL)
-	{
-	  error (_("unimplemented support for boolean repeats"));
-	}
-      else
-	{
-	  error (_("can't repeat values of that type"));
-	}
-    }
-  else if (type1->code () == TYPE_CODE_STRING
-	   || type1->code () == TYPE_CODE_CHAR)
-    {
-      /* We have two character strings to concatenate.  */
-      if (type2->code () != TYPE_CODE_STRING
-	  && type2->code () != TYPE_CODE_CHAR)
-	{
-	  error (_("Strings can only be concatenated with other strings."));
-	}
-      inval1len = TYPE_LENGTH (type1);
-      inval2len = TYPE_LENGTH (type2);
-      std::vector<char> ptr (inval1len + inval2len);
-      if (type1->code () == TYPE_CODE_CHAR)
-	{
-	  char_type = type1;
-
-	  ptr[0] = (char) unpack_long (type1, value_contents (inval1).data ());
-	}
-      else
-	{
-	  char_type = TYPE_TARGET_TYPE (type1);
-
-	  memcpy (ptr.data (), value_contents (inval1).data (), inval1len);
-	}
-      if (type2->code () == TYPE_CODE_CHAR)
-	{
-	  ptr[inval1len] =
-	    (char) unpack_long (type2, value_contents (inval2).data ());
-	}
-      else
-	{
-	  memcpy (&ptr[inval1len], value_contents (inval2).data (), inval2len);
-	}
-      outval = value_string (ptr.data (), inval1len + inval2len, char_type);
-    }
-  else if (type1->code () == TYPE_CODE_BOOL)
-    {
-      /* We have two bitstrings to concatenate.  */
-      if (type2->code () != TYPE_CODE_BOOL)
-	{
-	  error (_("Booleans can only be concatenated "
-		   "with other bitstrings or booleans."));
-	}
-      error (_("unimplemented support for boolean concatenation."));
+      elttype2 = TYPE_TARGET_TYPE (elttype2);
+      if (!get_array_bounds (type2, &low2, &high2))
+	error (_("could not determine array bounds on right-hand-side of "
+		 "array concatenation"));
     }
   else
     {
-      /* We don't know how to concatenate these operands.  */
-      error (_("illegal operands for concatenation."));
+      low2 = 0;
+      high2 = 0;
     }
-  return (outval);
+
+  if (!types_equal (elttype1, elttype2))
+    error (_("concatenation with different element types"));
+
+  LONGEST lowbound = current_language->c_style_arrays_p () ? 0 : 1;
+  LONGEST n_elts = (high1 - low1 + 1) + (high2 - low2 + 1);
+  struct type *atype = lookup_array_range_type (elttype1,
+						lowbound,
+						lowbound + n_elts - 1);
+
+  struct value *result = allocate_value (atype);
+  gdb::array_view<gdb_byte> contents = value_contents_raw (result);
+  gdb::array_view<const gdb_byte> lhs_contents = value_contents (arg1);
+  gdb::array_view<const gdb_byte> rhs_contents = value_contents (arg2);
+  gdb::copy (lhs_contents, contents.slice (0, lhs_contents.size ()));
+  gdb::copy (rhs_contents, contents.slice (lhs_contents.size ()));
+
+  return result;
 }
 \f
 /* Integer exponentiation: V1**V2, where both arguments are
-- 
2.34.1

Re: [PATCH 4/4] Reimplement array concatenation for Ada and D

[Eli Zaretskii]

> Date: Tue, 15 Mar 2022 07:25:00 -0600
> From: Tom Tromey via Gdb-patches <gdb-patches@sourceware.org>
> Cc: Tom Tromey <tromey@adacore.com>
> 
> This started as a patch to implement string concatenation for Ada.
> However, while working on this, I looked at how this code could
> possibly be called.  It turns out there are only two users of
> concat_operation: Ada and D.  So, in addition to implementing this for
> Ada, this patch rewrites value_concat, removing the odd "concatenate
> or repeat" semantics, which were completely unused.  As Ada and D both
> seem to represent strings using TYPE_CODE_ARRAY, this removes the
> TYPE_CODE_STRING code from there as well.
> ---
>  gdb/ada-exp.h                          |  15 +++
>  gdb/ada-exp.y                          |   2 +-
>  gdb/ada-lang.c                         |  58 ++++++++-
>  gdb/doc/gdb.texinfo                    |   5 +-
>  gdb/testsuite/gdb.ada/widewide.exp     |  12 ++
>  gdb/testsuite/gdb.dlang/expression.exp |   4 +
>  gdb/valarith.c                         | 169 ++++++-------------------
>  7 files changed, 131 insertions(+), 134 deletions(-)

OK for the documentation part.

Thanks.

Re: [PATCH 1/4] Remove eval_op_string

[Andrew Burgess]

Tom Tromey via Gdb-patches <gdb-patches@sourceware.org> writes:

> eval_op_string is only used in a single place -- the implementation of
> string_operation.  This patch turns it into the
> string_operation::evaluate method, removing a bit of extraneous code.
> ---
>  gdb/eval.c  | 15 ++++++++++-----
>  gdb/expop.h | 11 +----------
>  2 files changed, 11 insertions(+), 15 deletions(-)

LGTM.

Thanks,
Andrew


>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 6ced0b261e7..b7b8915fa89 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -1078,17 +1078,22 @@ eval_op_register (struct type *expect_type, struct expression *exp,
>      return val;
>  }
>  
> -/* Helper function that implements the body of OP_STRING.  */
> +namespace expr
> +{
>  
> -struct value *
> -eval_op_string (struct type *expect_type, struct expression *exp,
> -		enum noside noside, int len, const char *string)
> +value *
> +string_operation::evaluate (struct type *expect_type,
> +			    struct expression *exp,
> +			    enum noside noside)
>  {
> +  const std::string &str = std::get<0> (m_storage);
>    struct type *type = language_string_char_type (exp->language_defn,
>  						 exp->gdbarch);
> -  return value_string (string, len, type);
> +  return value_string (str.c_str (), str.size (), type);
>  }
>  
> +} /* namespace expr */
> +
>  /* Helper function that implements the body of OP_OBJC_SELECTOR.  */
>  
>  struct value *
> diff --git a/gdb/expop.h b/gdb/expop.h
> index 58863b8f3ab..1592568a857 100644
> --- a/gdb/expop.h
> +++ b/gdb/expop.h
> @@ -64,10 +64,6 @@ extern struct value *eval_op_func_static_var (struct type *expect_type,
>  extern struct value *eval_op_register (struct type *expect_type,
>  				       struct expression *exp,
>  				       enum noside noside, const char *name);
> -extern struct value *eval_op_string (struct type *expect_type,
> -				     struct expression *exp,
> -				     enum noside noside, int len,
> -				     const char *string);
>  extern struct value *eval_op_ternop (struct type *expect_type,
>  				     struct expression *exp,
>  				     enum noside noside,
> @@ -912,12 +908,7 @@ class string_operation
>  
>    value *evaluate (struct type *expect_type,
>  		   struct expression *exp,
> -		   enum noside noside) override
> -  {
> -    const std::string &str = std::get<0> (m_storage);
> -    return eval_op_string (expect_type, exp, noside,
> -			   str.size (), str.c_str ());
> -  }
> +		   enum noside noside) override;
>  
>    enum exp_opcode opcode () const override
>    { return OP_STRING; }
> -- 
> 2.34.1

Re: [PATCH 2/4] Ada support for wide strings

[Andrew Burgess]

Tom Tromey via Gdb-patches <gdb-patches@sourceware.org> writes:

> This adds some basic support for Wide_String and Wide_Wide_String to
> the Ada expression evaluator.  In particular, a string literal may be
> converted to a wide or wide-wide string depending on context.
>
> The patch updates an existing test case.  Note that another test,
> namely something like:
>
>     ptype Wide_Wide_String'("literal")
>
> ... would be nice to add, but when tested against a distro GNAT, this
> did not work (probably due to lack of debuginfo); so, I haven't
> included it here.

LGTM.

Thanks,
Andrew


> ---
>  gdb/ada-lang.c                         | 63 +++++++++++++++++++++++---
>  gdb/testsuite/gdb.ada/widewide.exp     |  4 ++
>  gdb/testsuite/gdb.ada/widewide/foo.adb |  2 +
>  3 files changed, 63 insertions(+), 6 deletions(-)
>
> diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
> index 12ff0353829..f097ad4b6f7 100644
> --- a/gdb/ada-lang.c
> +++ b/gdb/ada-lang.c
> @@ -10603,12 +10603,63 @@ ada_string_operation::evaluate (struct type *expect_type,
>  				struct expression *exp,
>  				enum noside noside)
>  {
> -  value *result = string_operation::evaluate (expect_type, exp, noside);
> -  /* The result type will have code OP_STRING, bashed there from 
> -     OP_ARRAY.  Bash it back.  */
> -  if (value_type (result)->code () == TYPE_CODE_STRING)
> -    value_type (result)->set_code (TYPE_CODE_ARRAY);
> -  return result;
> +  struct type *char_type;
> +  if (expect_type != nullptr && ada_is_string_type (expect_type))
> +    char_type = ada_array_element_type (expect_type, 1);
> +  else
> +    char_type = language_string_char_type (exp->language_defn, exp->gdbarch);
> +
> +  const std::string &str = std::get<0> (m_storage);
> +  const char *encoding;
> +  switch (TYPE_LENGTH (char_type))
> +    {
> +    case 1:
> +      {
> +	/* Simply copy over the data -- this isn't perhaps strictly
> +	   correct according to the encodings, but it is gdb's
> +	   historical behavior.  */
> +	struct type *stringtype
> +	  = lookup_array_range_type (char_type, 1, str.length ());
> +	struct value *val = allocate_value (stringtype);
> +	memcpy (value_contents_raw (val).data (), str.c_str (),
> +		str.length ());
> +	return val;
> +      }
> +
> +    case 2:
> +      if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
> +	encoding = "UTF-16BE";
> +      else
> +	encoding = "UTF-16LE";
> +      break;
> +
> +    case 4:
> +      if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
> +	encoding = "UTF-32BE";
> +      else
> +	encoding = "UTF-32LE";
> +      break;
> +
> +    default:
> +      error (_("unexpected character type size %s"),
> +	     pulongest (TYPE_LENGTH (char_type)));
> +    }
> +
> +  auto_obstack converted;
> +  convert_between_encodings (host_charset (), encoding,
> +			     (const gdb_byte *) str.c_str (),
> +			     str.length (), 1,
> +			     &converted, translit_none);
> +
> +  struct type *stringtype
> +    = lookup_array_range_type (char_type, 1,
> +			       obstack_object_size (&converted)
> +			       / TYPE_LENGTH (char_type));
> +  struct value *val = allocate_value (stringtype);
> +  memcpy (value_contents_raw (val).data (),
> +	  obstack_base (&converted),
> +	  obstack_object_size (&converted));
> +  return val;
>  }
>  
>  value *
> diff --git a/gdb/testsuite/gdb.ada/widewide.exp b/gdb/testsuite/gdb.ada/widewide.exp
> index c0268f9c99b..d68a0b112c4 100644
> --- a/gdb/testsuite/gdb.ada/widewide.exp
> +++ b/gdb/testsuite/gdb.ada/widewide.exp
> @@ -43,3 +43,7 @@ gdb_test "print my_wws(1)" "= 32 ' '"
>  
>  gdb_test "print my_wws(2)" "= 104 'h'"
>  
> +gdb_test "print my_wws = \" helo\"" " = true"
> +
> +gdb_test "print my_ws = \"wide\"" " = true"
> +gdb_test "print my_ws = \"nope\"" " = false"
> diff --git a/gdb/testsuite/gdb.ada/widewide/foo.adb b/gdb/testsuite/gdb.ada/widewide/foo.adb
> index 45adbde20a1..d41734a485f 100644
> --- a/gdb/testsuite/gdb.ada/widewide/foo.adb
> +++ b/gdb/testsuite/gdb.ada/widewide/foo.adb
> @@ -19,9 +19,11 @@ procedure Foo is
>     Some_Easy : Wide_Wide_Character := 'J';
>     Some_Larger : Wide_Wide_Character := Wide_Wide_Character'Val(16#beef#);
>     Some_Big : Wide_Wide_Character := Wide_Wide_Character'Val(16#00dabeef#);
> +   My_Ws : Wide_String := "wide";
>     My_WWS : Wide_Wide_String := " helo";
>  begin
>     Do_Nothing (Some_Easy'Address);  -- START
>     Do_Nothing (Some_Larger'Address);
> +   Do_Nothing (My_Ws'Address);
>     Do_Nothing (Some_Big'Address);
>  end Foo;
> -- 
> 2.34.1

Re: [PATCH 3/4] Remove eval_op_concat

[Andrew Burgess]

Tom Tromey via Gdb-patches <gdb-patches@sourceware.org> writes:

> eval_op_concat has code to search for an operator overload of
> BINOP_CONCAT.  However, the operator overloading code is specific to
> C++, which does not have this operator.  And,
> binop_types_user_defined_p rejects this case right at the start, and
> value_x_binop does not handle this case.  I think this code has been
> dead for a very long time.  This patch removes it and hoists the
> remaining call into concatenation::evaluate, removing eval_op_concat
> entirely.

I think this change makes sense.  So LGTM.

Thanks,
Andrew


> ---
>  gdb/eval.c     | 12 ------------
>  gdb/expop.h    |  6 +-----
>  gdb/valarith.c |  2 +-
>  3 files changed, 2 insertions(+), 18 deletions(-)
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index b7b8915fa89..266a4f7699f 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -1106,18 +1106,6 @@ eval_op_objc_selector (struct type *expect_type, struct expression *exp,
>  			     lookup_child_selector (exp->gdbarch, sel));
>  }
>  
> -/* Helper function that implements the body of BINOP_CONCAT.  */
> -
> -struct value *
> -eval_op_concat (struct type *expect_type, struct expression *exp,
> -		enum noside noside, struct value *arg1, struct value *arg2)
> -{
> -  if (binop_user_defined_p (BINOP_CONCAT, arg1, arg2))
> -    return value_x_binop (arg1, arg2, BINOP_CONCAT, OP_NULL, noside);
> -  else
> -    return value_concat (arg1, arg2);
> -}
> -
>  /* A helper function for TERNOP_SLICE.  */
>  
>  struct value *
> diff --git a/gdb/expop.h b/gdb/expop.h
> index 1592568a857..d903ab0bb7e 100644
> --- a/gdb/expop.h
> +++ b/gdb/expop.h
> @@ -83,10 +83,6 @@ extern struct value *eval_op_member (struct type *expect_type,
>  				     struct expression *exp,
>  				     enum noside noside,
>  				     struct value *arg1, struct value *arg2);
> -extern struct value *eval_op_concat (struct type *expect_type,
> -				     struct expression *exp,
> -				     enum noside noside,
> -				     struct value *arg1, struct value *arg2);
>  extern struct value *eval_op_add (struct type *expect_type,
>  				  struct expression *exp,
>  				  enum noside noside,
> @@ -1158,7 +1154,7 @@ class concat_operation
>        = std::get<0> (m_storage)->evaluate_with_coercion (exp, noside);
>      value *rhs
>        = std::get<1> (m_storage)->evaluate_with_coercion (exp, noside);
> -    return eval_op_concat (expect_type, exp, noside, lhs, rhs);
> +    return value_concat (lhs, rhs);
>    }
>  
>    enum exp_opcode opcode () const override
> diff --git a/gdb/valarith.c b/gdb/valarith.c
> index e13db10ab55..791c1cd9a06 100644
> --- a/gdb/valarith.c
> +++ b/gdb/valarith.c
> @@ -252,7 +252,7 @@ int
>  binop_types_user_defined_p (enum exp_opcode op,
>  			    struct type *type1, struct type *type2)
>  {
> -  if (op == BINOP_ASSIGN || op == BINOP_CONCAT)
> +  if (op == BINOP_ASSIGN)
>      return 0;
>  
>    type1 = check_typedef (type1);
> -- 
> 2.34.1

Re: [PATCH 4/4] Reimplement array concatenation for Ada and D

[Andrew Burgess]

Tom Tromey via Gdb-patches <gdb-patches@sourceware.org> writes:

> This started as a patch to implement string concatenation for Ada.
> However, while working on this, I looked at how this code could
> possibly be called.  It turns out there are only two users of
> concat_operation: Ada and D.  So, in addition to implementing this for
> Ada, this patch rewrites value_concat, removing the odd "concatenate
> or repeat" semantics, which were completely unused.  As Ada and D both
> seem to represent strings using TYPE_CODE_ARRAY, this removes the
> TYPE_CODE_STRING code from there as well.

LGTM.

Thanks,
Andrew


> ---
>  gdb/ada-exp.h                          |  15 +++
>  gdb/ada-exp.y                          |   2 +-
>  gdb/ada-lang.c                         |  58 ++++++++-
>  gdb/doc/gdb.texinfo                    |   5 +-
>  gdb/testsuite/gdb.ada/widewide.exp     |  12 ++
>  gdb/testsuite/gdb.dlang/expression.exp |   4 +
>  gdb/valarith.c                         | 169 ++++++-------------------
>  7 files changed, 131 insertions(+), 134 deletions(-)
>
> diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
> index 765f0dca3c5..44ca2545670 100644
> --- a/gdb/ada-exp.h
> +++ b/gdb/ada-exp.h
> @@ -769,6 +769,21 @@ class ada_char_operation : public long_const_operation,
>  			bool parse_completion,
>  			innermost_block_tracker *tracker,
>  			struct type *context_type) override;
> +
> +  value *evaluate (struct type *expect_type,
> +		   struct expression *exp,
> +		   enum noside noside) override;
> +};
> +
> +class ada_concat_operation : public concat_operation
> +{
> +public:
> +
> +  using concat_operation::concat_operation;
> +
> +  value *evaluate (struct type *expect_type,
> +		   struct expression *exp,
> +		   enum noside noside) override;
>  };
>  
>  } /* namespace expr */
> diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
> index c974657dbcd..1f98f10f984 100644
> --- a/gdb/ada-exp.y
> +++ b/gdb/ada-exp.y
> @@ -649,7 +649,7 @@ simple_exp	:	simple_exp '+' simple_exp
>  	;
>  
>  simple_exp	:	simple_exp '&' simple_exp
> -			{ ada_wrap2<concat_operation> (BINOP_CONCAT); }
> +			{ ada_wrap2<ada_concat_operation> (BINOP_CONCAT); }
>  	;
>  
>  simple_exp	:	simple_exp '-' simple_exp
> diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
> index f097ad4b6f7..0f772fd7b46 100644
> --- a/gdb/ada-lang.c
> +++ b/gdb/ada-lang.c
> @@ -10552,6 +10552,17 @@ convert_char_literal (struct type *type, LONGEST val)
>    return val;
>  }
>  
> +value *
> +ada_char_operation::evaluate (struct type *expect_type,
> +			      struct expression *exp,
> +			      enum noside noside)
> +{
> +  value *result = long_const_operation::evaluate (expect_type, exp, noside);
> +  if (expect_type != nullptr)
> +    result = ada_value_cast (expect_type, result);
> +  return result;
> +}
> +
>  /* See ada-exp.h.  */
>  
>  operation_up
> @@ -10572,7 +10583,7 @@ ada_char_operation::replace (operation_up &&owner,
>  	= convert_char_literal (context_type, std::get<1> (m_storage));
>      }
>  
> -  return make_operation<ada_wrapped_operation> (std::move (result));
> +  return result;
>  }
>  
>  value *
> @@ -10662,6 +10673,51 @@ ada_string_operation::evaluate (struct type *expect_type,
>    return val;
>  }
>  
> +value *
> +ada_concat_operation::evaluate (struct type *expect_type,
> +				struct expression *exp,
> +				enum noside noside)
> +{
> +  /* If one side is a literal, evaluate the other side first so that
> +     the expected type can be set properly.  */
> +  const operation_up &lhs_expr = std::get<0> (m_storage);
> +  const operation_up &rhs_expr = std::get<1> (m_storage);
> +
> +  value *lhs, *rhs;
> +  if (dynamic_cast<ada_string_operation *> (lhs_expr.get ()) != nullptr)
> +    {
> +      rhs = rhs_expr->evaluate (nullptr, exp, noside);
> +      lhs = lhs_expr->evaluate (value_type (rhs), exp, noside);
> +    }
> +  else if (dynamic_cast<ada_char_operation *> (lhs_expr.get ()) != nullptr)
> +    {
> +      rhs = rhs_expr->evaluate (nullptr, exp, noside);
> +      struct type *rhs_type = check_typedef (value_type (rhs));
> +      struct type *elt_type = nullptr;
> +      if (rhs_type->code () == TYPE_CODE_ARRAY)
> +	elt_type = TYPE_TARGET_TYPE (rhs_type);
> +      lhs = lhs_expr->evaluate (elt_type, exp, noside);
> +    }
> +  else if (dynamic_cast<ada_string_operation *> (rhs_expr.get ()) != nullptr)
> +    {
> +      lhs = lhs_expr->evaluate (nullptr, exp, noside);
> +      rhs = rhs_expr->evaluate (value_type (lhs), exp, noside);
> +    }
> +  else if (dynamic_cast<ada_char_operation *> (rhs_expr.get ()) != nullptr)
> +    {
> +      lhs = lhs_expr->evaluate (nullptr, exp, noside);
> +      struct type *lhs_type = check_typedef (value_type (lhs));
> +      struct type *elt_type = nullptr;
> +      if (lhs_type->code () == TYPE_CODE_ARRAY)
> +	elt_type = TYPE_TARGET_TYPE (lhs_type);
> +      rhs = rhs_expr->evaluate (elt_type, exp, noside);
> +    }
> +  else
> +    return concat_operation::evaluate (expect_type, exp, noside);
> +
> +  return value_concat (lhs, rhs);
> +}
> +
>  value *
>  ada_qual_operation::evaluate (struct type *expect_type,
>  			      struct expression *exp,
> diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
> index d216fa1d529..729f9d79a93 100644
> --- a/gdb/doc/gdb.texinfo
> +++ b/gdb/doc/gdb.texinfo
> @@ -18094,10 +18094,7 @@ operand of the membership (@code{in}) operator.
>  @end itemize
>  
>  @item
> -The names in
> -@code{Characters.Latin_1} are not available and
> -concatenation is not implemented.  Thus, escape characters in strings are 
> -not currently available.
> +The names in @code{Characters.Latin_1} are not available.
>  
>  @item
>  Equality tests (@samp{=} and @samp{/=}) on arrays test for bitwise
> diff --git a/gdb/testsuite/gdb.ada/widewide.exp b/gdb/testsuite/gdb.ada/widewide.exp
> index d68a0b112c4..2f14a0faee8 100644
> --- a/gdb/testsuite/gdb.ada/widewide.exp
> +++ b/gdb/testsuite/gdb.ada/widewide.exp
> @@ -47,3 +47,15 @@ gdb_test "print my_wws = \" helo\"" " = true"
>  
>  gdb_test "print my_ws = \"wide\"" " = true"
>  gdb_test "print my_ws = \"nope\"" " = false"
> +
> +gdb_test "print \"x\" & my_ws & \"y\"" " = \"xwidey\""
> +
> +gdb_test "print my_wws(1..3) := \"abc\"" " = \"abc\""
> +gdb_test "print my_wws" " = \"abclo\"" \
> +    "print my_wws after slice assignment"
> +gdb_test "print my_wws(1..3) := my_wws(2..4)" " = \"bcl\""
> +gdb_test "print my_wws" " = \"bcllo\"" \
> +    "print my_wws after overlapping slice assignment"
> +
> +gdb_test "print 'x' & my_ws" " = \"xwide\""
> +gdb_test "print my_ws & 'y'" " = \"widey\""
> diff --git a/gdb/testsuite/gdb.dlang/expression.exp b/gdb/testsuite/gdb.dlang/expression.exp
> index 1ac6dca6248..6173dca713b 100644
> --- a/gdb/testsuite/gdb.dlang/expression.exp
> +++ b/gdb/testsuite/gdb.dlang/expression.exp
> @@ -121,6 +121,10 @@ proc test_d_expressions {} {
>  
>      gdb_test_no_output "set \$var = 144 ^^ 0.5" ""
>      gdb_test "print \$var ^^= 2" "144"
> +
> +    gdb_test "print 1 ~ \[2, 3\]" " = \\\{1, 2, 3\\\}"
> +    gdb_test "print \[1, 2\] ~ 3" " = \\\{1, 2, 3\\\}"
> +    gdb_test "print \[1, 2\] ~ \[2, 3\]" " = \\\{1, 2, 2, 3\\\}"
>  }
>  
>  # Start with a fresh gdb.
> diff --git a/gdb/valarith.c b/gdb/valarith.c
> index 791c1cd9a06..36d30f161f6 100644
> --- a/gdb/valarith.c
> +++ b/gdb/valarith.c
> @@ -651,153 +651,66 @@ value_x_unop (struct value *arg1, enum exp_opcode op, enum noside noside)
>  }
>  \f
>  
> -/* Concatenate two values with the following conditions:
> -
> -   (1)  Both values must be either bitstring values or character string
> -   values and the resulting value consists of the concatenation of
> -   ARG1 followed by ARG2.
> -
> -   or
> -
> -   One value must be an integer value and the other value must be
> -   either a bitstring value or character string value, which is
> -   to be repeated by the number of times specified by the integer
> -   value.
> -
> -
> -   (2)  Boolean values are also allowed and are treated as bit string
> -   values of length 1.
> -
> -   (3)  Character values are also allowed and are treated as character
> -   string values of length 1.  */
> +/* Concatenate two values.  One value must be an array; and the other
> +   value must either be an array with the same element type, or be of
> +   the array's element type.  */
>  
>  struct value *
>  value_concat (struct value *arg1, struct value *arg2)
>  {
> -  struct value *inval1;
> -  struct value *inval2;
> -  struct value *outval = NULL;
> -  int inval1len, inval2len;
> -  int count, idx;
> -  char inchar;
>    struct type *type1 = check_typedef (value_type (arg1));
>    struct type *type2 = check_typedef (value_type (arg2));
> -  struct type *char_type;
>  
> -  /* First figure out if we are dealing with two values to be concatenated
> -     or a repeat count and a value to be repeated.  INVAL1 is set to the
> -     first of two concatenated values, or the repeat count.  INVAL2 is set
> -     to the second of the two concatenated values or the value to be 
> -     repeated.  */
> +  if (type1->code () != TYPE_CODE_ARRAY && type2->code () != TYPE_CODE_ARRAY)
> +    error ("no array provided to concatenation");
>  
> -  if (type2->code () == TYPE_CODE_INT)
> +  LONGEST low1, high1;
> +  struct type *elttype1 = type1;
> +  if (elttype1->code () == TYPE_CODE_ARRAY)
>      {
> -      struct type *tmp = type1;
> -
> -      type1 = tmp;
> -      tmp = type2;
> -      inval1 = arg2;
> -      inval2 = arg1;
> +      elttype1 = TYPE_TARGET_TYPE (elttype1);
> +      if (!get_array_bounds (type1, &low1, &high1))
> +	error (_("could not determine array bounds on left-hand-side of "
> +		 "array concatenation"));
>      }
>    else
>      {
> -      inval1 = arg1;
> -      inval2 = arg2;
> +      low1 = 0;
> +      high1 = 0;
>      }
>  
> -  /* Now process the input values.  */
> -
> -  if (type1->code () == TYPE_CODE_INT)
> +  LONGEST low2, high2;
> +  struct type *elttype2 = type2;
> +  if (elttype2->code () == TYPE_CODE_ARRAY)
>      {
> -      /* We have a repeat count.  Validate the second value and then
> -	 construct a value repeated that many times.  */
> -      if (type2->code () == TYPE_CODE_STRING
> -	  || type2->code () == TYPE_CODE_CHAR)
> -	{
> -	  count = longest_to_int (value_as_long (inval1));
> -	  inval2len = TYPE_LENGTH (type2);
> -	  std::vector<char> ptr (count * inval2len);
> -	  if (type2->code () == TYPE_CODE_CHAR)
> -	    {
> -	      char_type = type2;
> -
> -	      inchar = (char) unpack_long (type2,
> -					   value_contents (inval2).data ());
> -	      for (idx = 0; idx < count; idx++)
> -		{
> -		  ptr[idx] = inchar;
> -		}
> -	    }
> -	  else
> -	    {
> -	      char_type = TYPE_TARGET_TYPE (type2);
> -
> -	      for (idx = 0; idx < count; idx++)
> -		memcpy (&ptr[idx * inval2len], value_contents (inval2).data (),
> -			inval2len);
> -	    }
> -	  outval = value_string (ptr.data (), count * inval2len, char_type);
> -	}
> -      else if (type2->code () == TYPE_CODE_BOOL)
> -	{
> -	  error (_("unimplemented support for boolean repeats"));
> -	}
> -      else
> -	{
> -	  error (_("can't repeat values of that type"));
> -	}
> -    }
> -  else if (type1->code () == TYPE_CODE_STRING
> -	   || type1->code () == TYPE_CODE_CHAR)
> -    {
> -      /* We have two character strings to concatenate.  */
> -      if (type2->code () != TYPE_CODE_STRING
> -	  && type2->code () != TYPE_CODE_CHAR)
> -	{
> -	  error (_("Strings can only be concatenated with other strings."));
> -	}
> -      inval1len = TYPE_LENGTH (type1);
> -      inval2len = TYPE_LENGTH (type2);
> -      std::vector<char> ptr (inval1len + inval2len);
> -      if (type1->code () == TYPE_CODE_CHAR)
> -	{
> -	  char_type = type1;
> -
> -	  ptr[0] = (char) unpack_long (type1, value_contents (inval1).data ());
> -	}
> -      else
> -	{
> -	  char_type = TYPE_TARGET_TYPE (type1);
> -
> -	  memcpy (ptr.data (), value_contents (inval1).data (), inval1len);
> -	}
> -      if (type2->code () == TYPE_CODE_CHAR)
> -	{
> -	  ptr[inval1len] =
> -	    (char) unpack_long (type2, value_contents (inval2).data ());
> -	}
> -      else
> -	{
> -	  memcpy (&ptr[inval1len], value_contents (inval2).data (), inval2len);
> -	}
> -      outval = value_string (ptr.data (), inval1len + inval2len, char_type);
> -    }
> -  else if (type1->code () == TYPE_CODE_BOOL)
> -    {
> -      /* We have two bitstrings to concatenate.  */
> -      if (type2->code () != TYPE_CODE_BOOL)
> -	{
> -	  error (_("Booleans can only be concatenated "
> -		   "with other bitstrings or booleans."));
> -	}
> -      error (_("unimplemented support for boolean concatenation."));
> +      elttype2 = TYPE_TARGET_TYPE (elttype2);
> +      if (!get_array_bounds (type2, &low2, &high2))
> +	error (_("could not determine array bounds on right-hand-side of "
> +		 "array concatenation"));
>      }
>    else
>      {
> -      /* We don't know how to concatenate these operands.  */
> -      error (_("illegal operands for concatenation."));
> +      low2 = 0;
> +      high2 = 0;
>      }
> -  return (outval);
> +
> +  if (!types_equal (elttype1, elttype2))
> +    error (_("concatenation with different element types"));
> +
> +  LONGEST lowbound = current_language->c_style_arrays_p () ? 0 : 1;
> +  LONGEST n_elts = (high1 - low1 + 1) + (high2 - low2 + 1);
> +  struct type *atype = lookup_array_range_type (elttype1,
> +						lowbound,
> +						lowbound + n_elts - 1);
> +
> +  struct value *result = allocate_value (atype);
> +  gdb::array_view<gdb_byte> contents = value_contents_raw (result);
> +  gdb::array_view<const gdb_byte> lhs_contents = value_contents (arg1);
> +  gdb::array_view<const gdb_byte> rhs_contents = value_contents (arg2);
> +  gdb::copy (lhs_contents, contents.slice (0, lhs_contents.size ()));
> +  gdb::copy (rhs_contents, contents.slice (lhs_contents.size ()));
> +
> +  return result;
>  }
>  \f
>  /* Integer exponentiation: V1**V2, where both arguments are
> -- 
> 2.34.1