[PATCH 2/4] Ada support for wide strings

[Tom Tromey <tromey@adacore.com>]

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