gdb/testsuite/gdb.guile/scm-lazy-string.exp

   1 # Copyright (C) 2008-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 # This file is part of the GDB testsuite.
  17 # It tests the mechanism exposing lazy strings to Guile.
  18
  19 load_lib gdb-guile.exp
  20
  21 require allow_guile_tests
  22
  23 standard_testfile
  24
  25 if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
  26     return
  27 }
  28
  29 #gdb_install_guile_utils
  30 #gdb_install_guile_module
  31
  32 # The following tests require execution.
  33
  34 if ![gdb_guile_runto_main] {
  35     return
  36 }
  37
  38 gdb_breakpoint [gdb_get_line_number "break here"]
  39 gdb_continue_to_breakpoint "break here"
  40
  41 gdb_scm_test_silent_cmd "gu (define null (parse-and-eval \"null\"))" 1
  42
  43 gdb_scm_test_silent_cmd "gu (define nullstr (value->lazy-string null #:length 0))" "create a null lazy string" 1
  44 gdb_test "gu (print (lazy-string-length nullstr))" "= 0" "null lazy string length"
  45 gdb_test "gu (print (lazy-string-address nullstr))" "= 0" "null lazy string address"
  46 gdb_test "gu (print (lazy-string-type nullstr))" "const char \\*" "null lazy string type"
  47 gdb_test "gu (print (lazy-string->value nullstr))" \
  48     "Out of range: cannot create a value from NULL.*Error while executing Scheme code." \
  49     "create value from NULL"
  50 gdb_test "gu (print (lazy-string->value (value->lazy-string null #:length 3)))" \
  51     "Out of range: cannot create a lazy string with address 0x0, and a non-zero length.*Error while executing Scheme code." \
  52     "null lazy string with non-zero length"
  53 gdb_test "gu (print (value->lazy-string null #:length -2))" \
  54     "Out of range: invalid length.*Error while executing Scheme code." \
  55     "bad length"
  56
  57 foreach var_spec { { "ptr" "pointer" "const char \\*" -1 } \
  58                    { "array" "array" "const char \\[6\\]" 6 } \
  59                    { "typedef_ptr" "typedef pointer" "pointer" -1 } } {
  60     set var [lindex $var_spec 0]
  61     set value [lindex $var_spec 1]
  62     set type [lindex $var_spec 2]
  63     set length [lindex $var_spec 3]
  64     with_test_prefix $var {
  65         gdb_test "print $var" "\"$value\""
  66         gdb_scm_test_silent_cmd "gu (define $var (history-ref 0))" "get value from history" 1
  67         gdb_scm_test_silent_cmd "gu (define l$var (value->lazy-string $var))" "acquire lazy string" 1
  68         gdb_test "gu (print (value-type $var))" "$type" "string type name equality"
  69         gdb_test "gu (print (lazy-string-type l$var))" "$type" "lazy-string type name equality"
  70         gdb_test "gu (print (lazy-string-length l$var))" "$length" "lazy string length"
  71         gdb_test "gu (print (lazy-string->value l$var))" "\"$value\"" "lazy string value"
  72         gdb_scm_test_silent_cmd "gu (define l2$var (value->lazy-string $var #:length 2))" "acquire lazy string, length 2" 1
  73         gdb_test "gu (print (lazy-string-length l2$var))" "2" "lazy string length 2"
  74         gdb_test "gu (print (lazy-string->value l2$var))" "\"[string range $value 0 1]\"" "lazy string length 2 value"
  75         # This test will have to wait until gdb can handle it. There's no way,
  76         # currently, to internally specify an array of length zero in the C
  77         # language support.  PR 20786
  78         #gdb_test "gu (print (lazy-string->value (value->lazy-string $var #:length 0)))" "\"\"" "empty lazy string value"
  79     }
  80 }