gdb/testsuite/gdb.guile/scm-block.exp

   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
  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"