binutils-gdb/gdb/testsuite/gdb.guile/scm-block.exp
Joel Brobecker 61baf725ec update copyright year range in GDB files
This applies the second part of GDB's End of Year Procedure, which
updates the copyright year range in all of GDB's files.

gdb/ChangeLog:

        Update copyright year range in all GDB files.
2017-01-01 10:52:34 +04:00

108 lines
3.9 KiB
Plaintext

# Copyright (C) 2010-2017 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# This file is part of the GDB testsuite.
# It tests the mechanism exposing blocks to Guile.
load_lib gdb-guile.exp
standard_testfile
if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
return -1
}
# Skip all tests if Guile scripting is not enabled.
if { [skip_guile_tests] } { continue }
if ![gdb_guile_runto_main] {
return
}
gdb_breakpoint [gdb_get_line_number "Block break here."]
gdb_continue_to_breakpoint "Block break here."
# Test initial innermost block.
gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
"Get frame inner"
gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
"Get block inner"
gdb_test "guile (print block)" "#<gdb:block $hex-$hex>" \
"Check block not #f"
gdb_test "guile (print (block-function block))" \
"#f" "First anonymous block"
gdb_test "guile (print (block-start block))" \
"${decimal}" "Check start not #f"
gdb_test "guile (print (block-end block))" \
"${decimal}" "Check end not #f"
# Test eq?.
gdb_test "guile (print (eq? (frame-block frame) (frame-block frame)))" \
"= #t" "Check eq? on same block"
gdb_test "guile (print (eq? block (block-global-block block)))" \
"= #f" "Check eq? on different blocks"
# Test global/static blocks.
gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
"Get frame for global/static"
gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
"Get block for global/static"
gdb_test "guile (print (block-global? block))" \
"#f" "Not a global block"
gdb_test "guile (print (block-static? block))" \
"#f" "Not a static block"
gdb_scm_test_silent_cmd "guile (define gblock (block-global-block block))" \
"Get global block"
gdb_scm_test_silent_cmd "guile (define sblock (block-static-block block))" \
"Get static block"
gdb_test "guile (print (block-global? gblock))" \
"#t" "Is the global block"
gdb_test "guile (print (block-static? sblock))" \
"#t" "Is the static block"
# Move up superblock(s) until we reach function block_func.
gdb_test_no_output "guile (set! block (block-superblock block))" \
"Get superblock"
gdb_test "guile (print (block-function block))" \
"#f" "Second anonymous block"
gdb_test_no_output "guile (set! block (block-superblock block))" \
"Get superblock 2"
gdb_test "guile (print (block-function block))" \
"block_func" "Print superblock 2 function"
# Switch frames, then test for main block.
gdb_test "up" ".*"
gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
"Get frame 2"
gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
"Get frame 2's block"
gdb_test "guile (print block)" "#<gdb:block main $hex-$hex>" \
"Check Frame 2's block not #f"
gdb_test "guile (print (block-function block))" \
"main" "main block"
# Test block-valid?. This must always be the last test in this
# testcase as it unloads the object file.
delete_breakpoints
gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
"Get frame for valid?"
gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
"Get frame block for valid?"
gdb_test "guile (print (block-valid? block))" \
"#t" "Check block validity"
gdb_unload
gdb_test "guile (print (block-valid? block))" \
"#f" "Check block validity after unload"