1# Copyright (C) 2010-2017 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 19load_lib gdb-guile.exp 20 21standard_testfile 22 23if {[prepare_for_testing "failed to prepare" $testfile $srcfile debug]} { 24 return -1 25} 26 27# Skip all tests if Guile scripting is not enabled. 28if { [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. 32gdb_install_guile_utils 33gdb_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. 38gdb_scm_test_silent_cmd "guile (define main-func (lookup-global-symbol \"main\"))" \ 39 "lookup main" 40gdb_test "guile (print (symbol-function? main-func))" \ 41 "= #t" "test (symbol-function? main)" 42gdb_test "guile (print (lookup-global-symbol \"junk\"))" \ 43 "= #f" "test (lookup-global-symbol junk)" 44 45gdb_test "guile (print (symbol-value main-func))" \ 46 "= {int \\(int, char \[*\]\[*\]\\)} $hex \\<main\\>" "print value of main" 47 48set qq_line [gdb_get_line_number "line of qq"] 49gdb_scm_test_silent_cmd "guile (define qq-var (lookup-global-symbol \"qq\"))" \ 50 "lookup qq" 51gdb_test "guile (print (symbol-line qq-var))" \ 52 "= $qq_line" "print line number of qq" 53gdb_test "guile (print (symbol-value qq-var))" \ 54 "= 72" "print value of qq" 55gdb_test "guile (print (symbol-needs-frame? qq-var))" \ 56 "= #f" "print whether qq needs a frame" 57 58if ![gdb_guile_runto_main] { 59 return 60} 61 62# Test symbol eq? and equal?. 63gdb_test "guile (print (eq? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \ 64 "= #t" 65gdb_test "guile (print (equal? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \ 66 "= #t" 67 68gdb_breakpoint [gdb_get_line_number "Block break here."] 69gdb_continue_to_breakpoint "Block break here." 70gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 71 "get frame at block break" 72gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \ 73 "get block at block break" 74 75# Test symbol-argument?. 76gdb_scm_test_silent_cmd "guile (define arg (car (lookup-symbol \"arg\")))" \ 77 "get variable arg" 78gdb_test "guile (print (symbol-variable? arg))" "= #f" 79gdb_test "guile (print (symbol-constant? arg))" "= #f" 80gdb_test "guile (print (symbol-argument? arg))" "= #t" 81gdb_test "guile (print (symbol-function? arg))" "= #f" 82 83# Test symbol-function?. 84gdb_scm_test_silent_cmd "guile (define func (block-function block))" \ 85 "get block function" 86gdb_test "guile (print (symbol-variable? func))" "= #f" 87gdb_test "guile (print (symbol-constant? func))" "= #f" 88gdb_test "guile (print (symbol-argument? func))" "= #f" 89gdb_test "guile (print (symbol-function? func))" "= #t" 90 91# Test attributes of func. 92gdb_test "guile (print (symbol-name func))" "func" 93gdb_test "guile (print (symbol-print-name func))" "func" 94gdb_test "guile (print (symbol-linkage-name func))" "func" 95gdb_test "guile (print (= (symbol-addr-class func) SYMBOL_LOC_BLOCK))" "= #t" 96 97gdb_breakpoint [gdb_get_line_number "Break at end."] 98gdb_continue_to_breakpoint "Break at end." 99gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 100 "get frame at end" 101 102# Test symbol-variable?. 103gdb_scm_test_silent_cmd "guile (define a (car (lookup-symbol \"a\")))" \ 104 "get variable a" 105gdb_test "guile (print (symbol-variable? a))" "= #t" 106gdb_test "guile (print (symbol-constant? a))" "= #f" 107gdb_test "guile (print (symbol-argument? a))" "= #f" 108gdb_test "guile (print (symbol-function? a))" "= #f" 109 110# Test attributes of a. 111gdb_test "guile (print (= (symbol-addr-class a) SYMBOL_LOC_COMPUTED))" "= #t" 112 113gdb_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" 116gdb_test "guile (print (symbol-value a #:frame frame))" \ 117 "= 0" "print value of a" 118gdb_test "guile (print (symbol-needs-frame? a))" \ 119 "= #t" "print whether a needs a frame" 120 121# Test symbol-constant?. 122gdb_scm_test_silent_cmd "guile (define t (car (lookup-symbol \"one\")))" \ 123 "get constant t" 124gdb_test "guile (print (symbol-variable? t))" "= #f" 125gdb_test "guile (print (symbol-constant? t))" "= #t" 126gdb_test "guile (print (symbol-argument? t))" "= #f" 127gdb_test "guile (print (symbol-function? t))" "= #f" 128 129# Test attributes of t. 130gdb_test "guile (print (= (symbol-addr-class t) SYMBOL_LOC_CONST))" "= #t" 131 132# Test type attribute. 133gdb_test "guile (print (symbol-type t))" "= enum tag" 134 135# Test symtab attribute. 136gdb_test "guile (print (symbol-symtab t))" "= #<gdb:symtab .*gdb.guile/scm-symbol.c>" 137 138# C++ tests 139# Recompile binary. 140if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}-cxx" executable "debug c++"] != "" } { 141 untested "failed to compile in C++ mode" 142 return -1 143} 144 145# Start with a fresh gdb. 146gdb_exit 147gdb_start 148gdb_reinitialize_dir $srcdir/$subdir 149gdb_load ${binfile}-cxx 150 151if ![gdb_guile_runto_main] { 152 return 153} 154 155gdb_breakpoint [gdb_get_line_number "Break in class."] 156gdb_continue_to_breakpoint "Break in class." 157 158gdb_scm_test_silent_cmd "guile (define cplusframe (selected-frame))" \ 159 "get frame at class" 160gdb_scm_test_silent_cmd "guile (define cplusfunc (block-function (frame-block cplusframe)))" \ 161 "get function at class" 162 163gdb_test "guile (print (symbol-variable? cplusfunc))" "= #f" 164gdb_test "guile (print (symbol-constant? cplusfunc))" "= #f" 165gdb_test "guile (print (symbol-argument? cplusfunc))" "= #f" 166gdb_test "guile (print (symbol-function? cplusfunc))" "= #t" 167 168gdb_test "guile (print (symbol-name cplusfunc))" \ 169 "= SimpleClass::valueofi().*" "test method.name" 170gdb_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) 174gdb_test "guile (print (symbol-linkage-name cplusfunc))" \ 175 "SimpleClass::valueofi().*" "test method.linkage_name" 176gdb_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. 181clean_restart ${testfile} 182if ![gdb_guile_runto_main] { 183 return 184} 185 186gdb_breakpoint [gdb_get_line_number "Break at end."] 187gdb_continue_to_breakpoint "Break at end." 188gdb_scm_test_silent_cmd "guile (define a (car (lookup-symbol \"a\")))" \ 189 "get variable a for unload" 190gdb_test "guile (print (symbol-valid? a))" \ 191 "= #t" "test symbol validity pre-unload" 192delete_breakpoints 193gdb_unload 194gdb_test "guile (print (symbol-valid? a))" \ 195 "= #f" "test symbol validity post-unload" 196gdb_test_no_output "guile (set! a #f) (gc)" "test symbol destructor" 197