Ada support for wide strings
authorTom Tromey <tromey@adacore.com>
Tue, 8 Mar 2022 17:54:44 +0000 (10:54 -0700)
committerTom Tromey <tromey@adacore.com>
Wed, 16 Mar 2022 15:28:13 +0000 (09:28 -0600)
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
gdb/testsuite/gdb.ada/widewide.exp
gdb/testsuite/gdb.ada/widewide/foo.adb

index 12ff03538297370d1a6c3189d9e331fc9f8bff28..f097ad4b6f77bf45063ceecbb95a75be486e3c5b 100644 (file)
@@ -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 *
index c0268f9c99b6315bb881e1d8b0e46e1e03f6c488..d68a0b112c484215a23b7a8308bd2df72acc7580 100644 (file)
@@ -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"
index 45adbde20a12a3f22d531c9b0e50d5a0fce5cd7f..d41734a485fd7ee7f650d01c20995500205c5e0c 100644 (file)
@@ -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;