gdb/testsuite/gdb.base/internal-string-values.exp

   1 # Copyright 2021-2024 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 # Test that string values are correctly allocated inside GDB when doing
  17 # various operations that yield strings.
  18 #
  19 # The issue that lead to this test was a missing NULL terminator in the
  20 # C-string values.  We verify that we can print the null terminator of these
  21 # strings.
  22
  23 load_lib "trace-support.exp"
  24 load_lib "gdb-guile.exp"
  25
  26 standard_testfile
  27
  28 if {[build_executable "failed to prepare" $testfile $srcfile ]} {
  29     return
  30 }
  31
  32 set user_conv_funcs {$_gdb_setting $_gdb_setting_str}
  33 set maint_conv_funcs {$_gdb_maint_setting $_gdb_maint_setting_str}
  34
  35 # Add language (LANG) appropriate quotation marks around string STR.
  36 proc quote_for_lang {lang str} {
  37     if {$lang == "fortran"} {
  38         return "'$str'"
  39     } else {
  40         return "\"$str\""
  41     }
  42 }
  43
  44 # Check that the string contained in the convenienced variable $v is
  45 # EXPECTED_STR.
  46 #
  47 # In particular, check that the null terminator is there and that we can't
  48 # access a character past the end of the string.
  49
  50 proc check_v_string { expected_str } {
  51     set len [string length $expected_str]
  52
  53     for { set i 0 } { $i < $len } { incr i } {
  54         set c [string index $expected_str $i]
  55         gdb_test "print \$v\[$i\]" "= $::decimal '$c'"
  56     }
  57
  58     # Check that the string ends with a null terminator.
  59     gdb_test "print \$v\[$i\]" {= 0 '\\000'}
  60
  61     # Check that we can't access a character after the end of the string.
  62     incr i
  63     gdb_test "print \$v\[$i\]" "no such vector element"
  64 }
  65
  66 # Test with string values made by $_gdb_setting & co.
  67
  68 proc_with_prefix test_setting { } {
  69     clean_restart
  70
  71     # This is an internal GDB implementation detail, but the variable backing
  72     # a string setting starts as nullptr (unless explicitly initialized at
  73     # startup).  When assigning an empty value, the variable then points to an
  74     # empty string.  Test both cases, as it triggers different code paths (in
  75     # addition to a non-empty value).
  76     #
  77     # Use "set trace-user" and "maintenance set test-settings string" as they
  78     # are both not initialized at startup.
  79     with_test_prefix "user setting" {
  80         with_test_prefix "not set" {
  81             foreach_with_prefix conv_func $::user_conv_funcs {
  82                 gdb_test_no_output "set \$v = ${conv_func}(\"trace-user\")"
  83                 check_v_string ""
  84             }
  85         }
  86
  87         with_test_prefix "set to empty" {
  88             gdb_test "set trace-user"
  89             foreach_with_prefix conv_func $::user_conv_funcs {
  90                 gdb_test_no_output "set \$v = ${conv_func}(\"trace-user\")"
  91                 check_v_string ""
  92             }
  93         }
  94
  95         with_test_prefix "set" {
  96             gdb_test "set trace-user poulet"
  97             foreach_with_prefix conv_func $::user_conv_funcs {
  98                 gdb_test_no_output {set $v = $_gdb_setting("trace-user")}
  99                 check_v_string "poulet"
 100             }
 101         }
 102     }
 103
 104     with_test_prefix "maintenance setting" {
 105         with_test_prefix "not set" {
 106             foreach_with_prefix conv_func $::maint_conv_funcs {
 107                 gdb_test_no_output \
 108                     "set \$v = ${conv_func}(\"test-settings string\")"
 109                 check_v_string ""
 110             }
 111         }
 112
 113         with_test_prefix "set to empty" {
 114             gdb_test "maintenance set test-settings string"
 115             foreach_with_prefix conv_func $::maint_conv_funcs {
 116                 gdb_test_no_output \
 117                     "set \$v = ${conv_func}(\"test-settings string\")"
 118                 check_v_string ""
 119             }
 120         }
 121
 122         with_test_prefix "set" {
 123             gdb_test "maintenance set test-settings string perchaude"
 124             foreach_with_prefix conv_func $::maint_conv_funcs {
 125                 gdb_test_no_output \
 126                     "set \$v = ${conv_func}(\"test-settings string\")"
 127                 check_v_string "perchaude"
 128             }
 129         }
 130     }
 131
 132     # Test with a non-string setting, this tests yet another code path.
 133     with_test_prefix "integer setting" {
 134         gdb_test_no_output {set $v = $_gdb_setting_str("remotetimeout")}
 135         check_v_string "2"
 136     }
 137
 138     # Test string values made by $_gdb_setting & co. in all languages.
 139     with_test_prefix "all langs" {
 140         # Get list of supported languages.
 141         set langs [gdb_supported_languages]
 142
 143         gdb_test "maintenance set test-settings string foo"
 144         foreach_with_prefix lang $langs {
 145             gdb_test_no_output "set language $lang"
 146
 147             if {$lang == "modula-2"} {
 148                 # The Modula-2 parser doesn't know how to build a
 149                 # suitable string expression.
 150                 gdb_test "print \"foo\"" "strings are not implemented"
 151                 continue
 152             }
 153
 154             if {$lang == "rust"} {
 155                 # Rust strings are actually structs, without a running
 156                 # inferior into which the string data can be pushed
 157                 # GDB can't print anything.
 158                 gdb_test "print \"foo\"" \
 159                     "evaluation of this expression requires the target program to be active"
 160                 gdb_test "print \$_gdb_maint_setting(\"test-settings string\")" \
 161                     "evaluation of this expression requires the target program to be active"
 162                 continue
 163             }
 164
 165             if {$lang == "unknown"} {
 166                 # Skipped because expression parsing is not supported
 167                 # for the "unknown" language.  See gdb/28093 for more
 168                 # details.
 169                 continue
 170             }
 171
 172             set print_output ""
 173             set ptype_output ""
 174
 175             set foo_str [quote_for_lang $lang foo]
 176             gdb_test_multiple "print $foo_str" "" {
 177                 -wrap -re " = (.*)" {
 178                     set print_output $expect_out(1,string)
 179                     pass $gdb_test_name
 180                 }
 181             }
 182
 183             gdb_test_multiple "ptype $foo_str" "" {
 184                 -wrap -re " = (.*)" {
 185                     set ptype_output $expect_out(1,string)
 186                     pass $gdb_test_name
 187                 }
 188             }
 189
 190             set cmd_str [quote_for_lang $lang "test-settings string"]
 191             set ptype_output_re [string_to_regexp $ptype_output]
 192             set print_output_re [string_to_regexp $print_output]
 193
 194             foreach_with_prefix conv_func $::maint_conv_funcs {
 195                 gdb_test "print ${conv_func}($cmd_str)" \
 196                     " = $print_output_re"
 197                 gdb_test "ptype \$" \
 198                     " = $ptype_output_re"
 199             }
 200         }
 201     }
 202 }
 203
 204 # Test with a string value created by gdb.Value in Python.
 205
 206 proc_with_prefix test_python_value { } {
 207     clean_restart
 208
 209     if {![allow_python_tests]} {
 210         untested "skipping test_python_value"
 211         return
 212     }
 213
 214     gdb_test_no_output "python gdb.set_convenience_variable(\"v\", \"bar\")" \
 215         "set convenience var"
 216     check_v_string "bar"
 217 }
 218
 219 # Test with a string value created by make-value in Guile.
 220
 221 proc_with_prefix test_guile_value { } {
 222     clean_restart
 223
 224     if {![allow_guile_tests]} {
 225         untested "skipping test_guile_value"
 226         return
 227     }
 228
 229     # We can't set a convenience var from Guile, but we can append to history.
 230     # Do that, then transfer to a convenience var with a CLI command.
 231     gdb_test_no_output "guile (use-modules (gdb))"
 232     gdb_test_multiple "guile (history-append! (make-value \"foo\"))" "make value" {
 233         -re -wrap "($::decimal)" {
 234             set histnum $expect_out(1,string)
 235         }
 236     }
 237
 238     gdb_test_no_output "set \$v = \$$histnum"
 239     check_v_string "foo"
 240 }
 241
 242 # Test with a string value coming from a string internal var.  The only internal
 243 # vars of this type, at the time of writing, are $trace_func and $trace_file.
 244 # They both require inspecting a trace frame.  So if the target is capable start
 245 # tracing, record one trace frame, and use $trace_func.
 246
 247 proc_with_prefix test_internal_var { } {
 248     if {![gdb_trace_common_supports_arch]} {
 249         unsupported "arch does not support trace"
 250         return
 251     }
 252
 253     clean_restart $::binfile
 254
 255     if {![runto_main]} {
 256         fail "could not run to main"
 257         return
 258     }
 259
 260     if {![gdb_target_supports_trace]} {
 261         unsupported "target does not support trace"
 262         return
 263     }
 264
 265     gdb_breakpoint "end"
 266     gdb_test "trace trace_me" "Tracepoint $::decimal at $::hex.*"
 267     gdb_test_no_output "tstart"
 268     gdb_continue_to_breakpoint "breakpoint at end"
 269     gdb_test_no_output "tstop"
 270     gdb_test "tfind" "Found trace frame 0, tracepoint $::decimal.*"
 271     gdb_test_no_output "set \$v = \$trace_func"
 272     gdb_test "tfind none" "No longer looking at any trace frame.*"
 273     check_v_string "trace_me"
 274 }
 275
 276 test_setting
 277 test_python_value
 278 test_guile_value
 279 test_internal_var