1# Copyright (C) 2009-2020 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 frame support in Guile. 18 19load_lib gdb-guile.exp 20 21standard_testfile 22 23if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } { 24 return -1 25} 26 27# Skip all tests if Guile scripting is not enabled. 28if { [skip_guile_tests] } { continue } 29 30# The following tests require execution. 31 32if ![gdb_guile_runto_main] { 33 return 34} 35 36gdb_breakpoint [gdb_get_line_number "Block break here."] 37gdb_continue_to_breakpoint "Block break here." 38gdb_scm_test_silent_cmd "guile (define bf1 (selected-frame))" \ 39 "get frame" 40 41# Test frame-architecture method. 42gdb_scm_test_silent_cmd "guile (define show-arch-str (execute \"show architecture\" #:to-string #t))" \ 43 "show arch" 44gdb_test "guile (print (->bool (string-contains show-arch-str (arch-name (frame-arch bf1)))))" \ 45 "#t" "test frame-arch" 46 47# First test that read-var is unaffected by PR 11036 changes. 48gdb_test "guile (print (frame-read-var bf1 \"i\"))" \ 49 "\"stuff\"" "test i" 50gdb_test "guile (print (frame-read-var bf1 \"f\"))" \ 51 "\"foo\"" "test f" 52gdb_test "guile (print (frame-read-var bf1 \"b\"))" \ 53 "\"bar\"" "test b" 54 55# Test the read-var function in another block other than the current 56# block (in this case, the super block). Test thar read-var is reading 57# the correct variables of i and f but they are the correct value and type. 58gdb_scm_test_silent_cmd "guile (define sb (block-superblock (frame-block bf1)))" \ 59 "get superblock" 60gdb_test "guile (print (frame-read-var bf1 \"i\" #:block sb))" "1.1.*" \ 61 "test i = 1.1" 62gdb_test "guile (print (value-type (frame-read-var bf1 \"i\" #:block sb)))" \ 63 "double" "test double i" 64gdb_test "guile (print (frame-read-var bf1 \"f\" #:block sb))" \ 65 "2.2.*" "test f = 2.2" 66gdb_test "guile (print (value-type (frame-read-var bf1 \"f\" #:block sb)))" \ 67 "double" "test double f" 68 69# And again test another outerblock, this time testing "i" is the 70# correct value and type. 71gdb_scm_test_silent_cmd "guile (set! sb (block-superblock sb))" \ 72 "get superblock #2" 73gdb_test "guile (print (frame-read-var bf1 \"i\" #:block sb))" \ 74 "99" "test i = 99" 75gdb_test "guile (print (value-type (frame-read-var bf1 \"i\" #:block sb)))" \ 76 "int" "test int i" 77 78gdb_breakpoint "f2" 79gdb_continue_to_breakpoint "breakpoint at f2" 80gdb_scm_test_silent_cmd "guile (define bframe (selected-frame))" \ 81 "get bottom-most frame" 82gdb_test "up" ".*" "" 83 84gdb_scm_test_silent_cmd "guile (define f1 (selected-frame))" \ 85"get second frame" 86gdb_scm_test_silent_cmd "guile (define f0 (frame-newer f1))" \ 87 "get first frame" 88 89gdb_test "guile (print (eq? f1 (newest-frame)))" \ 90 #f "selected frame -vs- newest frame" 91gdb_test "guile (print (eq? bframe (newest-frame)))" \ 92 #t "newest frame -vs- newest frame" 93 94gdb_test "guile (print (eq? f0 f1))" \ 95 "#f" "test equality comparison (false)" 96gdb_test "guile (print (eq? f0 f0))" \ 97 "#t" "test equality comparison (true)" 98gdb_test "guile (print (frame-valid? f0))" \ 99 "#t" "test frame-valid?" 100gdb_test "guile (print (frame-name f0))" \ 101 "f2" "test frame-name" 102gdb_test "guile (print (= (frame-type f0) NORMAL_FRAME))" \ 103 "#t" "test frame-type" 104gdb_test "guile (print (= (frame-unwind-stop-reason f0) FRAME_UNWIND_NO_REASON))" \ 105 "#t" "test frame-unwind-stop-reason" 106gdb_test "guile (print (unwind-stop-reason-string FRAME_UNWIND_INNER_ID))" \ 107 "previous frame inner to this frame \\(corrupt stack\\?\\)" \ 108 "test unwind-stop-reason-string" 109gdb_test "guile (print (format #f \"= ~A\" (frame-pc f0)))" \ 110 "= \[0-9\]+" "test frame-pc" 111gdb_test "guile (print (format #f \"= ~A\" (eq? (frame-older f0) f1)))" \ 112 "= #t" "test frame-older" 113gdb_test "guile (print (format #f \"= ~A\" (eq? (frame-newer f1) f0)))" \ 114 "= #t" "test frame-newer" 115gdb_test "guile (print (frame-read-var f0 \"variable_which_surely_doesnt_exist\"))" \ 116 "ERROR: .*: Out of range: variable not found: \"variable_which_surely_doesnt_exist\".*" \ 117 "test frame-read-var - error" 118gdb_test "guile (print (format #f \"= ~A\" (frame-read-var f0 \"a\")))" \ 119 "= 1" "test frame-read-var - success" 120 121gdb_test "guile (print (format #f \"= ~A\" (eq? (selected-frame) f1)))" \ 122 "= #t" "test selected-frame" 123 124# Can read SP register. 125gdb_test "guile (print (equal? (frame-read-register (selected-frame) \"sp\") (parse-and-eval \"\$sp\")))" \ 126 "= #t" "test frame-read-register of sp" 127 128# PC value obtained via read_register is as expected. 129gdb_test "guile (print (equal? (value->integer (frame-read-register f0 \"pc\")) (frame-pc f0)))" \ 130 "= #t" "test frame-read-register of pc" 131 132# Test arch-specific register name. 133set pc "" 134if {[is_amd64_regs_target]} { 135 set pc "rip" 136} elseif {[is_x86_like_target]} { 137 set pc "eip" 138} 139if { $pc != "" } { 140 gdb_test "guile (print (equal? (frame-read-register f0 \"pc\") (frame-read-register f0 \"$pc\")))" \ 141 "= #t" "test frame-read-register of $pc" 142} 143