Home | History | Annotate | Line # | Download | only in gdb.guile
scm-block.exp revision 1.5 
      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 blocks to Guile.
     18 
     19 load_lib gdb-guile.exp
     20 
     21 standard_testfile
     22 
     23 if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
     24     return -1
     25 }
     26 
     27 # Skip all tests if Guile scripting is not enabled.
     28 if { [skip_guile_tests] } { continue }
     29 
     30 if ![gdb_guile_runto_main] {
     31     return
     32 }
     33 
     34 gdb_breakpoint [gdb_get_line_number "Block break here."]
     35 gdb_continue_to_breakpoint "Block break here."
     36 
     37 # Test initial innermost block.
     38 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
     39     "Get frame inner"
     40 gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
     41     "Get block inner"
     42 gdb_test "guile (print block)" "#<gdb:block $hex-$hex>" \
     43     "Check block not #f"
     44 gdb_test "guile (print (block-function block))" \
     45     "#f" "First anonymous block"
     46 gdb_test "guile (print (block-start block))" \
     47     "${decimal}" "Check start not #f"
     48 gdb_test "guile (print (block-end block))" \
     49     "${decimal}" "Check end not #f"
     50 
     51 # Test eq?.
     52 gdb_test "guile (print (eq? (frame-block frame) (frame-block frame)))" \
     53      "= #t" "Check eq? on same block"
     54 gdb_test "guile (print (eq? block (block-global-block block)))" \
     55      "= #f" "Check eq? on different blocks"
     56 
     57 # Test global/static blocks.
     58 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
     59     "Get frame for global/static"
     60 gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
     61     "Get block for global/static"
     62 gdb_test "guile (print (block-global? block))" \
     63     "#f" "Not a global block"
     64 gdb_test "guile (print (block-static? block))" \
     65     "#f" "Not a static block"
     66 gdb_scm_test_silent_cmd "guile (define gblock (block-global-block block))" \
     67     "Get global block"
     68 gdb_scm_test_silent_cmd "guile (define sblock (block-static-block block))" \
     69     "Get static block"
     70 gdb_test "guile (print (block-global? gblock))" \
     71     "#t" "Is the global block"
     72 gdb_test "guile (print (block-static? sblock))" \
     73     "#t" "Is the static block"
     74 
     75 # Move up superblock(s) until we reach function block_func.
     76 gdb_test_no_output "guile (set! block (block-superblock block))" \
     77     "Get superblock"
     78 gdb_test "guile (print (block-function block))" \
     79     "#f" "Second anonymous block"
     80 gdb_test_no_output "guile (set! block (block-superblock block))" \
     81     "Get superblock 2"
     82 gdb_test "guile (print (block-function block))" \
     83     "block_func" "Print superblock 2 function"
     84 
     85 # Switch frames, then test for main block.
     86 gdb_test "up" ".*"
     87 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
     88     "Get frame 2"
     89 gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
     90     "Get frame 2's block"
     91 gdb_test "guile (print block)" "#<gdb:block main $hex-$hex>" \
     92     "Check Frame 2's block not #f"
     93 gdb_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.
     98 delete_breakpoints
     99 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
    100     "Get frame for valid?"
    101 gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
    102     "Get frame block for valid?"
    103 gdb_test "guile (print (block-valid? block))" \
    104     "#t" "Check block validity"
    105 gdb_unload
    106 gdb_test "guile (print (block-valid? block))" \
    107     "#f" "Check block validity after unload"
    108