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

   1 # Copyright (C) 2010-2023 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 Guile symbol table support.
  18
  19 load_lib gdb-guile.exp
  20
  21 require allow_guile_tests
  22
  23 standard_testfile scm-symtab.c scm-symtab-2.c
  24
  25 if {[prepare_for_testing "failed to prepare" $testfile \
  26          [list $srcfile $srcfile2] debug]} {
  27     return
  28 }
  29
  30 if ![gdb_guile_runto_main] {
  31     return
  32 }
  33
  34 set debug_types [debug_types]
  35
  36 # Setup and get the symbol table.
  37 set line_no [gdb_get_line_number "Block break here."]
  38 gdb_breakpoint $line_no
  39 gdb_continue_to_breakpoint "Block break here."
  40 gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
  41     "get frame"
  42 gdb_scm_test_silent_cmd "guile (define sal (frame-sal frame))" \
  43     "get sal"
  44 gdb_scm_test_silent_cmd "guile (define symtab (sal-symtab sal))" \
  45     "get symtab"
  46 gdb_scm_test_silent_cmd "guile (define global-block (symtab-global-block symtab))" \
  47     "get global block"
  48 gdb_scm_test_silent_cmd "guile (define static-block (symtab-static-block symtab))" \
  49     "get static block"
  50
  51 gdb_scm_test_silent_cmd "guile (define global-symbols (map symbol-name (block-symbols global-block)))" \
  52     "get global symbol names"
  53 gdb_scm_test_silent_cmd "guile (define static-symbols (map symbol-name (block-symbols static-block)))" \
  54     "get static symbol names"
  55 gdb_scm_test_silent_cmd "guile (define global-isymbols '()) (define static-isymbols '())" \
  56     "set up iterated symbol name lists"
  57 # TODO: iterated symbols
  58 gdb_scm_test_silent_cmd "step" "Step to the next line"
  59 gdb_scm_test_silent_cmd "guile (define new-pc (sal-pc (frame-sal (selected-frame))))" \
  60     "get new pc"
  61
  62 # Test sal.
  63 gdb_test "guile (print (sal-symtab sal))" \
  64     " (.*/)?scm-symtab.c.*" "Test sal-symtab"
  65 gdb_test "guile (print (sal-pc sal))" \
  66     "${decimal}" "test sal-pc"
  67 gdb_test "guile (print (= (sal-last sal) (- new-pc 1)))" \
  68     "#t" "test sal-last"
  69 gdb_test "guile (print (sal-line sal))" \
  70     "$line_no" "test sal-line"
  71 gdb_test "guile (print (sal-valid? sal))" \
  72     "#t" "test sal-valid?"
  73
  74 # Test eq? on symtabs.
  75 gdb_scm_test_silent_cmd "guile (define sal1 (frame-sal frame))" \
  76     "get sal1"
  77 gdb_scm_test_silent_cmd "guile (define sal2 (frame-sal (frame-older frame)))" \
  78     "get sal2"
  79 gdb_test "guile (print (eq? symtab (sal-symtab sal1)))" \
  80     "= #t" "test eq? of equal symtabs"
  81 gdb_test "guile (print (eq? symtab (sal-symtab sal2)))" \
  82     "= #t" "test eq? of equal symtabs from different sals"
  83 gdb_test "guile (print (eq? symtab (symbol-symtab (lookup-global-symbol \"func1\"))))" \
  84     "= #f" "test eq? of not-equal symtabs"
  85
  86 # Test symbol table.
  87 gdb_test "guile (print (symtab-filename symtab))" \
  88     " (.*/)?scm-symtab.c.*" "test symtab-filename"
  89 gdb_test "guile (print (symtab-objfile symtab))" \
  90     "#<gdb:objfile .*scm-symtab>" "test symtab-objfile"
  91 if { [is_remote host] } {
  92     gdb_test "guile (print (symtab-fullname symtab))" \
  93         " (.*/)scm-symtab.c.*" "test symtab-fullname"
  94 } else {
  95     gdb_test "guile (print (symtab-fullname symtab))" \
  96         "testsuite/gdb.guile/scm-symtab.c.*" "test symtab-fullname"
  97 }
  98 gdb_test "guile (print (symtab-valid? symtab))" \
  99     "#t" "test symtab-valid?"
 100 gdb_test "guile (print (->bool (member \"qq\" global-symbols)))" \
 101     "#t" "test qq in global symbols"
 102 gdb_test "guile (print (->bool (member \"func\" global-symbols)))" \
 103     "#t" "test func in global symbols"
 104 gdb_test "guile (print (->bool (member \"main\" global-symbols)))" \
 105     "#t" "test main in global symbols"
 106 gdb_test "guile (print (->bool (member \"int\" static-symbols)))" \
 107     "#t" "test int in static symbols"
 108 gdb_test "guile (print (->bool (member \"char\" static-symbols)))" \
 109     "#t" "test char in static symbols"
 110 gdb_test_multiple \
 111     "guile (print (->bool (member \"simple_struct\" static-symbols)))" \
 112     "test simple_struct in static symbols" {
 113         -re -wrap "#t" {
 114             pass $gdb_test_name
 115         }
 116         -re -wrap "#f" {
 117             if { $debug_types } {
 118                 # Xfail for PR gcc/90232.
 119                 xfail $gdb_test_name
 120             } else {
 121                 fail $gdb_test_name
 122             }
 123         }
 124     }
 125
 126 # Test is_valid when the objfile is unloaded.  This must be the last
 127 # test as it unloads the object file in GDB.
 128 gdb_unload
 129 gdb_test "guile (print (sal-valid? sal))" \
 130     "#f" "test sal-valid? after unloading"
 131 gdb_test "guile (print (symtab-valid? symtab))" \
 132     "#f" "test symtab-valid? after unloading"
 133
 134 gdb_test_no_output "guile (set! sal #f)" \
 135     "test sal destructor"
 136 gdb_test_no_output "guile (set! symtab #f)" \
 137     "test symtab destructor"
 138 gdb_test_no_output "guile (gc)" "GC to trigger destructors"
 139
 140 # Start with a fresh gdb.
 141 clean_restart ${testfile}
 142
 143 # Test find-pc-line.
 144 # The following tests require execution.
 145
 146 if ![gdb_guile_runto_main] {
 147     return
 148 }
 149
 150 runto [gdb_get_line_number "Break at func2 call site."]
 151
 152 gdb_scm_test_silent_cmd "guile (define line (sal-line (frame-sal (selected-frame))))" \
 153     "get line number of func2 call site"
 154 gdb_test "guile (print (= (sal-line (find-pc-line (frame-pc (selected-frame)))) line))" \
 155     "#t" "test find-pc-line at func2 call site"
 156
 157 gdb_scm_test_silent_cmd "step" "step into func2"
 158 gdb_scm_test_silent_cmd "up" "step out of func2"
 159
 160 gdb_test "guile (print (>= (sal-line (find-pc-line (frame-pc (selected-frame)))) line))" \
 161     "#t" "test find-pc-line with resume address"