1 # Copyright (C) 2010-2025 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 symbols 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 "failed to prepare" $testfile $srcfile debug]} { 26 return -1 27 } 28 29 # These tests are done before we call gdb_guile_runto_main so we have to 30 # import the gdb module ourselves. 31 gdb_install_guile_utils 32 gdb_install_guile_module 33 34 # Test looking up a global symbol before we runto_main as this is the 35 # point where we don't have a current frame, and we don't want to 36 # require one. 37 gdb_scm_test_silent_cmd "guile (define main-func (lookup-global-symbol \"main\"))" \ 38 "lookup main" 39 gdb_test "guile (print (symbol-function? main-func))" \ 40 "= #t" "test, symbol-function? main" 41 gdb_test "guile (print (lookup-global-symbol \"junk\"))" \ 42 "= #f" "test, lookup-global-symbol junk" 43 44 gdb_test "guile (print (symbol-value main-func))" \ 45 "= {int \\(int, char \[*\]\[*\]\\)} $hex \\<main\\>" "print value of main" 46 47 set qq_line [gdb_get_line_number "line of qq"] 48 gdb_scm_test_silent_cmd "guile (define qq-var (lookup-global-symbol \"qq\"))" \ 49 "lookup qq" 50 gdb_test "guile (print (symbol-line qq-var))" \ 51 "= $qq_line" "print line number of qq" 52 gdb_test "guile (print (symbol-value qq-var))" \ 53 "= 72" "print value of qq" 54 gdb_test "guile (print (symbol-needs-frame? qq-var))" \ 55 "= #f" "print whether qq needs a frame" 56 57 if ![gdb_guile_runto_main] { 58 return 59 } 60 61 # Test symbol eq? and equal?. 62 gdb_test "guile (print (eq? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \ 63 "= #t" 64 gdb_test "guile (print (equal? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \ 65 "= #t" 66 67 gdb_breakpoint [gdb_get_line_number "Block break here."] 68 gdb_continue_to_breakpoint "Block break here." 69 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 70 "get frame at block break" 71 gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \ 72 "get block at block break" 73 74 # Test symbol-argument?. 75 gdb_scm_test_silent_cmd "guile (define arg (car (lookup-symbol \"arg\")))" \ 76 "get variable arg" 77 gdb_test "guile (print (symbol-variable? arg))" "= #f" 78 gdb_test "guile (print (symbol-constant? arg))" "= #f" 79 gdb_test "guile (print (symbol-argument? arg))" "= #t" 80 gdb_test "guile (print (symbol-function? arg))" "= #f" 81 82 # Test symbol-function?. 83 gdb_scm_test_silent_cmd "guile (define func (block-function block))" \ 84 "get block function" 85 gdb_test "guile (print (symbol-variable? func))" "= #f" 86 gdb_test "guile (print (symbol-constant? func))" "= #f" 87 gdb_test "guile (print (symbol-argument? func))" "= #f" 88 gdb_test "guile (print (symbol-function? func))" "= #t" 89 90 # Test attributes of func. 91 gdb_test "guile (print (symbol-name func))" "func" 92 gdb_test "guile (print (symbol-print-name func))" "func" 93 gdb_test "guile (print (symbol-linkage-name func))" "func" 94 gdb_test "guile (print (= (symbol-addr-class func) SYMBOL_LOC_BLOCK))" "= #t" 95 96 gdb_breakpoint [gdb_get_line_number "Break at end."] 97 gdb_continue_to_breakpoint "Break at end." 98 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 99 "get frame at end" 100 101 # Test symbol-variable?. 102 gdb_scm_test_silent_cmd "guile (define a (car (lookup-symbol \"a\")))" \ 103 "get variable a" 104 gdb_test "guile (print (symbol-variable? a))" "= #t" 105 gdb_test "guile (print (symbol-constant? a))" "= #f" 106 gdb_test "guile (print (symbol-argument? a))" "= #f" 107 gdb_test "guile (print (symbol-function? a))" "= #f" 108 109 # Test attributes of a. 110 gdb_test "guile (print (= (symbol-addr-class a) SYMBOL_LOC_COMPUTED))" "= #t" 111 112 gdb_test "guile (print (symbol-value a))" \ 113 "ERROR: Symbol requires a frame to compute its value.*"\ 114 "try to print value of a without a frame" 115 gdb_test "guile (print (symbol-value a #:frame frame))" \ 116 "= 0" "print value of a" 117 gdb_test "guile (print (symbol-needs-frame? a))" \ 118 "= #t" "print whether a needs a frame" 119 120 # Test symbol-constant?. 121 gdb_scm_test_silent_cmd "guile (define t (car (lookup-symbol \"one\")))" \ 122 "get constant t" 123 gdb_test "guile (print (symbol-variable? t))" "= #f" 124 gdb_test "guile (print (symbol-constant? t))" "= #t" 125 gdb_test "guile (print (symbol-argument? t))" "= #f" 126 gdb_test "guile (print (symbol-function? t))" "= #f" 127 128 # Test attributes of t. 129 gdb_test "guile (print (= (symbol-addr-class t) SYMBOL_LOC_CONST))" "= #t" 130 131 # Test type attribute. 132 gdb_test "guile (print (symbol-type t))" "= enum tag" 133 134 # Test symtab attribute. 135 gdb_test "guile (print (symbol-symtab t))" "= #<gdb:symtab (.*/)?scm-symbol.c>" 136 137 # C++ tests 138 # Recompile binary. 139 if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}-cxx" executable "debug c++"] != "" } { 140 untested "failed to compile in C++ mode" 141 return -1 142 } 143 144 clean_restart ${::testfile}-cxx 145 146 if ![gdb_guile_runto_main] { 147 return 148 } 149 150 gdb_breakpoint [gdb_get_line_number "Break in class."] 151 gdb_continue_to_breakpoint "Break in class." 152 153 gdb_scm_test_silent_cmd "guile (define cplusframe (selected-frame))" \ 154 "get frame at class" 155 gdb_scm_test_silent_cmd "guile (define cplusfunc (block-function (frame-block cplusframe)))" \ 156 "get function at class" 157 158 gdb_test "guile (print (symbol-variable? cplusfunc))" "= #f" 159 gdb_test "guile (print (symbol-constant? cplusfunc))" "= #f" 160 gdb_test "guile (print (symbol-argument? cplusfunc))" "= #f" 161 gdb_test "guile (print (symbol-function? cplusfunc))" "= #t" 162 163 gdb_test "guile (print (symbol-name cplusfunc))" \ 164 "= SimpleClass::valueofi().*" "test method.name" 165 gdb_test "guile (print (symbol-print-name cplusfunc))" \ 166 "= SimpleClass::valueofi().*" "test method.print_name" 167 gdb_test "guile (print (symbol-linkage-name cplusfunc))" \ 168 "_ZN11SimpleClass8valueofiEv.*" "test method.linkage_name" 169 gdb_test "guile (print (= (symbol-addr-class cplusfunc) SYMBOL_LOC_BLOCK))" "= #t" 170 171 # Test is_valid when the objfile is unloaded. This must be the last 172 # test as it unloads the object file in GDB. 173 # Start with a fresh gdb. 174 clean_restart ${testfile} 175 if ![gdb_guile_runto_main] { 176 return 177 } 178 179 gdb_breakpoint [gdb_get_line_number "Break at end."] 180 gdb_continue_to_breakpoint "Break at end again" 181 gdb_scm_test_silent_cmd "guile (define a (car (lookup-symbol \"a\")))" \ 182 "get variable a for unload" 183 gdb_test "guile (print (symbol-valid? a))" \ 184 "= #t" "test symbol validity pre-unload" 185 delete_breakpoints 186 gdb_unload 187 gdb_test "guile (print (symbol-valid? a))" \ 188 "= #f" "test symbol validity post-unload" 189 gdb_test_no_output "guile (set! a #f) (gc)" "test symbol destructor" 190
Indexes created Sun Apr 12 00:22:20 UTC 2026