1# Copyright (C) 2010-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 mechanism exposing blocks to 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 30if ![gdb_guile_runto_main] { 31 return 32} 33 34gdb_breakpoint [gdb_get_line_number "Block break here."] 35gdb_continue_to_breakpoint "Block break here." 36 37# Test initial innermost block. 38gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 39 "Get frame inner" 40gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \ 41 "Get block inner" 42gdb_test "guile (print block)" "#<gdb:block $hex-$hex>" \ 43 "Check block not #f" 44gdb_test "guile (print (block-function block))" \ 45 "#f" "First anonymous block" 46gdb_test "guile (print (block-start block))" \ 47 "${decimal}" "Check start not #f" 48gdb_test "guile (print (block-end block))" \ 49 "${decimal}" "Check end not #f" 50 51# Test eq?. 52gdb_test "guile (print (eq? (frame-block frame) (frame-block frame)))" \ 53 "= #t" "Check eq? on same block" 54gdb_test "guile (print (eq? block (block-global-block block)))" \ 55 "= #f" "Check eq? on different blocks" 56 57# Test global/static blocks. 58gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 59 "Get frame for global/static" 60gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \ 61 "Get block for global/static" 62gdb_test "guile (print (block-global? block))" \ 63 "#f" "Not a global block" 64gdb_test "guile (print (block-static? block))" \ 65 "#f" "Not a static block" 66gdb_scm_test_silent_cmd "guile (define gblock (block-global-block block))" \ 67 "Get global block" 68gdb_scm_test_silent_cmd "guile (define sblock (block-static-block block))" \ 69 "Get static block" 70gdb_test "guile (print (block-global? gblock))" \ 71 "#t" "Is the global block" 72gdb_test "guile (print (block-static? sblock))" \ 73 "#t" "Is the static block" 74 75# Move up superblock(s) until we reach function block_func. 76gdb_test_no_output "guile (set! block (block-superblock block))" \ 77 "Get superblock" 78gdb_test "guile (print (block-function block))" \ 79 "#f" "Second anonymous block" 80gdb_test_no_output "guile (set! block (block-superblock block))" \ 81 "Get superblock 2" 82gdb_test "guile (print (block-function block))" \ 83 "block_func" "Print superblock 2 function" 84 85# Switch frames, then test for main block. 86gdb_test "up" ".*" 87gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 88 "Get frame 2" 89gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \ 90 "Get frame 2's block" 91gdb_test "guile (print block)" "#<gdb:block main $hex-$hex>" \ 92 "Check Frame 2's block not #f" 93gdb_test "guile (print (block-function block))" \ 94 "main" "main block" 95 96# Test block-valid?. This must always be the last test in this 97# testcase as it unloads the object file. 98delete_breakpoints 99gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \ 100 "Get frame for valid?" 101gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \ 102 "Get frame block for valid?" 103gdb_test "guile (print (block-valid? block))" \ 104 "#t" "Check block validity" 105gdb_unload 106gdb_test "guile (print (block-valid? block))" \ 107 "#f" "Check block validity after unload" 108