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