# This testcase is part of GDB, the GNU debugger. # Copyright 2001-2023 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 . # Please email any bugs, comments, and/or additions to this file to: # bug-gdb@gnu.org # Test GDB's character set support. standard_testfile .c charset-malloc.c if { [prepare_for_testing "failed to prepare" ${testfile} [list $srcfile $srcfile2]] } { return -1 } # Parse the output from a `show charset' command. Return the host # and target charset as a two-element list. proc parse_show_charset_output {testname} { global gdb_prompt gdb_expect { -re "The host character set is \"(.*)\"\\.\[\r\n\]+The target character set is \"(.*)\"\\.\[\r\n\]+The target wide character set is \"(.*)\"\\.\[\r\n\]+$gdb_prompt $" { set host_charset $expect_out(1,string) set target_charset $expect_out(2,string) set retlist [list $host_charset $target_charset] pass $testname } -re "The host character set is \"(.*)\"\\.\[\r\n\]+$gdb_prompt $" { set host_charset $expect_out(1,string) set retlist [list $host_charset] pass $testname } -re "The target character set is \"(.*)\"\\.\[\r\n\]+$gdb_prompt $" { set target_charset $expect_out(1,string) set retlist [list $target_charset] pass $testname } -re ".*$gdb_prompt $" { fail $testname } timeout { fail "$testname (timeout)" } } return $retlist } # Try the various `show charset' commands. send_gdb "show charset\n" set show_charset [parse_show_charset_output "show charset"] send_gdb "show target-charset\n" set show_target_charset \ [lindex [parse_show_charset_output "show target-charset"] 0] if {[lsearch -exact $show_charset $show_target_charset] >= 0} { pass "check `show target-charset' against `show charset'" } else { fail "check `show target-charset' against `show charset'" } send_gdb "show host-charset\n" set show_host_charset \ [lindex [parse_show_charset_output "show host-charset"] 0] if {[lsearch -exact $show_charset $show_host_charset] >= 0} { pass "check `show host-charset' against `show charset'" } else { fail "check `show host-charset' against `show charset'" } # Try a malformed `set charset'. gdb_test "set charset" \ "Requires an argument. Valid arguments are.*" \ "try malformed `set charset'" # Try using `set host-charset' on an invalid character set. gdb_test "set host-charset my_grandma_bonnie" \ "Undefined item: \"my_grandma_bonnie\"." \ "try `set host-charset' with invalid charset" # Try using `set target-charset' on an invalid character set. gdb_test "set target-charset my_grandma_bonnie" \ "Undefined item: \"my_grandma_bonnie\"." \ "try `set target-charset' with invalid charset" # A Tcl array mapping the names of all the character sets we've seen # to "1" if the character set can be used as a host character set, or # "0" otherwise. We can use `array names charsets' just to get a list # of all character sets. array set charsets {} proc all_charset_names {} { global charsets return [array names charsets] } proc valid_host_charset {charset} { global charsets return [expr {[info exists charsets($charset)] && $charsets($charset)}] } proc valid_target_charset {charset} { global charsets return [info exists charsets($charset)] } send_gdb "set host-charset\n" gdb_expect { -re "Requires an argument. Valid arguments are (.*)\\.\r\n$gdb_prompt $" { set host_charset_list $expect_out(1,string) regsub -all {, } $host_charset_list {,} host_charset_list foreach host_charset [split $host_charset_list ","] { set charsets($host_charset) 1 } pass "capture valid host charsets" } -re ".*$gdb_prompt $" { fail "capture valid host charsets" } timeout { fail "(timeout) capture valid host charsets" } } # If gdb was built with a phony iconv, it will only have two character # sets: "auto" and the default. In this situation, this set of tests # is pointless. if {[llength [array names charsets]] < 3} { untested "fewer than 3 charsets" return -1 } send_gdb "set target-charset\n" gdb_expect { -re "Requires an argument. Valid arguments are (.*)\\.\r\n$gdb_prompt $" { set target_charset_list $expect_out(1,string) regsub -all {, } $target_charset_list {,} target_charset_list foreach target_charset [split $target_charset_list ","] { if {! [info exists charsets($target_charset)]} { set charsets($target_charset) 0 } } pass "capture valid target charsets" } -re ".*$gdb_prompt $" { fail "capture valid target charsets" } timeout { fail "(timeout) capture valid target charsets" } } # We don't want to test all the charset names here, since that would # be too many combinations. We we pick a subset. set charset_subset {ASCII ISO-8859-1 EBCDIC-US IBM1047} foreach_with_prefix host_charset $charset_subset { if {[valid_host_charset $host_charset]} { set testname "try `set host-charset $host_charset'" send_gdb "set host-charset $host_charset\n" gdb_expect { -re "GDB doesn't know of any character set named.*\[\r\n]+${gdb_prompt} $" { # How did it get into `charsets' then? fail "$testname (didn't recognize name)" } -re "GDB can't use `.*' as its host character set\\.\[\r\n]+${gdb_prompt} $" { # Well, then why does its `charsets' entry say it can? fail $testname } -re "${gdb_prompt} $" { pass $testname } timeout { fail "$testname (timeout)" } } # Check that the command actually had its intended effect: # $host_charset should now be the host character set. send_gdb "show charset\n" set result [parse_show_charset_output "parse `show charset' after `set host-charset $host_charset'"] if {! [string compare [lindex $result 0] $host_charset]} { pass "check effect of `set host-charset $host_charset'" } else { fail "check effect of `set host-charset $host_charset'" } # Now try setting every possible target character set, # given that host charset. foreach target_charset $charset_subset { if {![valid_target_charset $target_charset]} { continue } set testname "try `set target-charset $target_charset'" send_gdb "set target-charset $target_charset\n" gdb_expect { -re "GDB doesn't know of any character set named.*\[\r\n]+${gdb_prompt} $" { fail "$testname (didn't recognize name)" } -re "GDB can't convert from the .* character set to .*\\.\[\r\n\]+${gdb_prompt} $" { # This is a serious problem. GDB should be able to convert # between any arbitrary pair of character sets. fail "$testname (can't convert)" } -re "${gdb_prompt} $" { pass $testname } timeout { fail "$testname (timeout)" } } # Check that the command actually had its intended effect: # $target_charset should now be the target charset. send_gdb "show charset\n" set result [parse_show_charset_output "parse `show charset' after `set target-charset $target_charset'"] if {! [string compare $result [list $host_charset $target_charset]]} { pass "check effect of `set target-charset $target_charset'" } else { fail "check effect of `set target-charset $target_charset'" } # Test handling of characters in the host charset which # can't be translated into the target charset. \xA2 is # `cent' in ISO-8859-1, which has no equivalent in ASCII. # # On some systems, the pseudo-tty through which we # communicate with GDB insists on stripping the high bit # from input characters, meaning that `cent' turns into # `"'. Since ISO-8859-1 and ASCII are identical in the # lower 128 characters, it's tough to see how we can test # this behavior on such systems, so we just xfail it. # # Note: the \x16 (Control-V) is an escape to allow \xA2 to # get past readline. if {! [string compare $host_charset iso-8859-1] && ! [string compare $target_charset ascii]} { set testname "untranslatable character in character literal" send_gdb "print '\x16\xA2'\n" gdb_expect { -re "There is no character corresponding to .* in the target character set .*\\.\[\r\n\]+$gdb_prompt $" { pass $testname } -re " = 34 '\"'\[\r\n\]+$gdb_prompt $" { xfail "$testname (DejaGNU's pseudo-tty strips eighth bit)" } -re "$gdb_prompt $" { fail $testname } timeout { fail "$testname (timeout)" } } set testname "untranslatable character in string literal" # If the PTTY zeros bit seven, then this turns into # print """ # which gets us a syntax error. We don't care. send_gdb "print \"\x16\xA2\"\n" gdb_expect { -re "There is no character corresponding to .* in the target character set .*\\.\[\r\n\]+$gdb_prompt $" { pass $testname } -re "Unterminated string in expression.\[\r\n\]+$gdb_prompt $" { xfail "$testname (DejaGNU's pseudo-tty strips eighth bit)" } -re "$gdb_prompt $" { fail $testname } timeout { fail "$testname (timeout)" } } set testname "untranslatable characters in backslash escape" send_gdb "print '\\\x16\xA2'\n" gdb_expect { -re "The escape sequence .* is equivalent to plain .*, which has no equivalent\[\r\n\]+in the .* character set\\.\[\r\n\]+$gdb_prompt $" { pass $testname } -re " = 34 '\"'\[\r\n\]+$gdb_prompt $" { xfail "$testname (DejaGNU's pseudo-tty strips eighth bit)" } -re "$gdb_prompt $" { fail $testname } timeout { fail "$testname (timeout)" } } } } } } # Set the host character set to plain ASCII, and try actually printing # some strings in various target character sets. We need to run the # test program to the point at which the strings have been # initialized. gdb_test "break ${srcfile}:[gdb_get_line_number "all strings initialized"]" \ ".*Breakpoint.* at .*" \ "set breakpoint after all strings have been initialized" gdb_run_cmd gdb_test "" "Breakpoint.*all strings initialized.*" "run until all strings have been initialized" # We only try the wide character tests on machines where the wchar_t # typedef in the test case has the right size. set wchar_size [get_sizeof wchar_t 99] set wchar_ok 0 if {$wchar_size == 2} { lappend charset_subset UTF-16 set wchar_ok 1 } elseif {$wchar_size == 4} { lappend charset_subset UTF-32 set wchar_ok 1 } gdb_test_no_output "set host-charset ASCII" foreach target_charset $charset_subset { if {![valid_target_charset $target_charset]} { continue } if {$target_charset == "UTF-32" || $target_charset == "UTF-16"} { set param target-wide-charset set L L } else { set param target-charset set L "" } gdb_test_no_output "set $param $target_charset" # Try printing the null character. There seems to be a bug in # gdb_test that requires us to use gdb_expect here. send_gdb "print $L'\\0'\n" gdb_expect { -re "\\\$${decimal} = 0 $L'\\\\000'\[\r\n\]+$gdb_prompt $" { pass "print the null character in ${target_charset}" } -re "$gdb_prompt $" { fail "print the null character in ${target_charset}" } timeout { fail "print the null character in ${target_charset} (timeout)" } } # Compute the name of the variable in the test program that holds # a string in $target_charset. The variable's name is the # character set's name, in lower-case, with all non-identifier # characters replaced with '_', with "_string" stuck on the end. if {$target_charset == "UTF-16"} { # We still use the utf_32_string variable -- but the size is # correct for UTF-16. set var_name utf_32_string } else { set var_name [string tolower "${target_charset}_string"] regsub -all -- "\[^a-z0-9_\]" $var_name "_" var_name } # Compute a regexp matching the results we expect. This is static, # but it's easier than writing it out. regsub -all "." "abfnrtv" "(\\\\&|x)" escapes set uppercase "ABCDEFGHIJKLMNOPQRSTUVWXYZ" set lowercase "abcdefghijklmnopqrstuvwxyz" set digits "0123456789" set octal_escape "\\\\\[0-9\]+" send_gdb "print $var_name\n" # ${escapes}${uppercase}${lowercase}${digits}${octal}${octal} gdb_expect { -re ".* = $L\"(\\\\a|x)(\\\\b|x)(\\\\f|x)(\\\\n|x)(\\\\r|x)(\\\\t|x)(\\\\v|x)${uppercase}${lowercase}${digits}(${octal_escape}|x)+\"\[\r\n\]+$gdb_prompt $" { pass "print string in $target_charset" } -re "$gdb_prompt $" { fail "print string in $target_charset" } timeout { fail "print string in $target_charset (timeout)" } } # Try entering a character literal, and see if it comes back unchanged. gdb_test "print $L'A'" \ " = \[0-9-\]+ $L'A'" \ "parse character literal in ${target_charset}" # Check that the character literal was encoded correctly. gdb_test "print /d $L'A' == $var_name\[7\]" \ " = 1" \ "check value of parsed character literal in ${target_charset}" # Try entering a string literal, and see if it comes back unchanged. gdb_test "print $L\"abcdefABCDEF012345\"" \ " = $L\"abcdefABCDEF012345\"" \ "parse string literal in ${target_charset}" # Check that the string literal was encoded correctly. gdb_test "print /d $L\"q\"\[0\] == $var_name\[49\]" \ " = 1" \ "check value of parsed string literal in ${target_charset}" # Test handling of characters in the target charset which # can't be translated into the host charset. if {! [string compare $target_charset iso-8859-1]} { gdb_test "print iso_8859_1_string\[69\]" \ " = \[0-9-\]+ '\\\\242'" \ "print character with no equivalent in host character set" gdb_test "print iso_8859_1_string + 70" \ " = ${hex} \"\\\\242.*\"" \ "print string with no equivalent in host character set" } # Make sure that we don't apply the ISO-8859-1 `print_literally' # function to ASCII. if {! [string compare $target_charset ascii]} { gdb_test "print iso_8859_1_string\[69\]" \ " = \[0-9-\]+ '\\\\242'" \ "print ASCII unprintable character" gdb_test "print iso_8859_1_string + 70" \ " = ${hex} \"\\\\242.*\"" \ "print ASCII unprintable string" } # Try printing characters with backslash escape equivalents. set escapees {a b f n r t v} for {set i 0} {$i < [llength $escapees]} {incr i} { set escape [lindex $escapees $i] send_gdb "print $var_name\[$i\]\n" set have_escape 1 gdb_expect { -re "= \[0-9-\]+ $L'\\\\${escape}'\[\r\n\]+$gdb_prompt $" { pass "try printing '\\${escape}' in ${target_charset}" } -re "= \[0-9-\]+ 'x'\[\r\n\]+$gdb_prompt $" { xfail "try printing '\\${escape}' in ${target_charset} (no such escape)" set have_escape 0 } -re "$gdb_prompt $" { fail "try printing '\\${escape}' in ${target_charset}" } timeout { fail "try printing '\\${escape}' in ${target_charset} (timeout)" } } if {$have_escape} { # Try parsing a backslash escape in a character literal. gdb_test "print /d $L'\\${escape}' == $var_name\[$i\]" \ " = 1" \ "check value of '\\${escape}' in ${target_charset}" # Try parsing a backslash escape in a string literal. gdb_test "print /d $L\"\\${escape}\"\[0\] == $var_name\[$i\]" \ " = 1" \ "check value of \"\\${escape}\" in ${target_charset}" } } # Try printing a character escape that doesn't exist. We should # get the unescaped character, in the target character set. gdb_test "print $L'\\q'" " = \[0-9-\]+ $L'q'" \ "print escape that doesn't exist in $target_charset" gdb_test "print /d $L'\\q' == $var_name\[49\]" " = 1" \ "check value of escape that doesn't exist in $target_charset" } # Reset the target charset. gdb_test_no_output "set target-charset UTF-8" # \242 is not a valid UTF-8 character. gdb_test "print \"\\242\"" " = \"\\\\242\"" \ "non-representable target character" gdb_test "print '\\x'" "\\\\x escape without a following hex digit" gdb_test "print '\\u'" "\\\\u escape without a following hex digit" gdb_test "print '\\9'" " = \[0-9\]+ '9'" # An octal escape can only be 3 digits. gdb_test "print \"\\1011\"" " = \"A1\"" # The final digit does not need to be escaped here. foreach val {0 1 2 3 4 5 6 7 8 9 a b c d e f} { gdb_test "print \"\\0\" \"${val}\"" " = \"\\\\000${val}\"" } # Tests for wide- or unicode- strings. L is the prefix letter to use, # either "L" (for wide strings), "u" (for UTF-16), or "U" (for UTF-32). # NAME is used in the test names and should be related to the prefix # letter in some easy-to-undestand way. proc test_wide_or_unicode {L name} { gdb_test "print $L\"ab\" $L\"c\"" " = $L\"abc\"" \ "basic $name string concatenation" gdb_test "print $L\"ab\" \"c\"" " = $L\"abc\"" \ "narrow and $name string concatenation" gdb_test "print \"ab\" $L\"c\"" " = $L\"abc\"" \ "$name and narrow string concatenation" gdb_test "print $L\"\\xe\" $L\"c\"" " = $L\"\\\\016c\"" \ "$name string concatenation with escape" gdb_test "print $L\"\" \"abcdef\" \"g\"" \ "$L\"abcdefg\"" \ "concatenate three strings with empty $name string" gdb_test "print $L\"\\xffef\" $L\"f\"" \ "$L\"\\\\xffef\\\\146\"" \ "test multi-char escape sequence case for $name" gdb_test "print $L'a'" "= \[0-9\]+ $L'a'" \ "basic $name character" } if {$wchar_ok} { test_wide_or_unicode L wide } set ucs2_ok [expr {[get_sizeof char16_t 99] == 2}] if ![valid_host_charset "UTF-16"] { verbose -log "Disabling UTF-16 tests." set ucs2_ok 0 } if {$ucs2_ok} { test_wide_or_unicode u UTF-16 } set ucs4_ok [expr {[get_sizeof char32_t 99] == 4}] if {$ucs4_ok} { test_wide_or_unicode U UTF-32 } # Test an invalid string combination. proc test_combination {L1 name1 L2 name2} { gdb_test "print $L1\"abc\" $L2\"def\"" \ "Undefined string concatenation." \ "undefined concatenation of $name1 and $name2" } if {$wchar_ok && $ucs2_ok} { test_combination L wide u UTF-16 } if {$wchar_ok && $ucs4_ok} { test_combination L wide U UTF-32 # Regression test for a typedef to a typedef. gdb_test "print myvar" "= \[0-9\]+ L'A'" \ "typedef to wchar_t" } if {$ucs2_ok && $ucs4_ok} { test_combination u UTF-16 U UTF-32 } if {$ucs2_ok} { set go 1 gdb_test_multiple "python print ('hello, world!')" \ "verify python support for charset tests" { -re "not supported.*$gdb_prompt $" { unsupported "python support is disabled" set go 0 } -re "$gdb_prompt $" {} } if {$go} { gdb_test "print u\"abcdef\"" " = u\"abcdef\"" \ "set up for python printing of utf-16 string" gdb_test "python print (gdb.history(0).string())" "abcdef" \ "extract utf-16 string using python" } } # Regression test for a cleanup bug in the charset code. gdb_test "print /d 'a' == 'a' || 'b' == 'b'" \ ".* = 1" \ "EVAL_SKIP cleanup handling regression test" proc string_display { var_name set_prefix x_size x_type} { with_test_prefix "set_prefix=$set_prefix" { gdb_test_no_output "set ${var_name} = ${set_prefix}\"Test String\\0with zeroes\""\ "assign ${var_name} with prefix ${set_prefix}" gdb_test "x /2${x_size}s ${var_name}" ".*\t${x_type}\"Test String\"\[\r\n\]+.*\t${x_type}\"with zeroes\"" \ "display String ${var_name} with x/${x_size}s" } } if {$ucs2_ok} { string_display String16 u h u if {$wchar_size == 2} { string_display String16 L h u } } string_display String32 U w U if {$wchar_size == 4} { string_display String32 L w U } foreach name {short int long} { # We're really just checking to make sure this doesn't give an # error. gdb_test "print ${name}_array = \"hi\"" \ " = {.*}" \ "assign string to $name array" } gdb_exit