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

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