Add "info connections" command, "info inferiors" connection number/string
[deliverable/binutils-gdb.git] / gdb / testsuite / gdb.guile / scm-progspace.exp
CommitLineData
b811d2c2 1# Copyright (C) 2010-2020 Free Software Foundation, Inc.
ded03782
DE
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 program space support in Guile.
18
19load_lib gdb-guile.exp
20
21standard_testfile
22
23if {[build_executable $testfile.exp $testfile $srcfile debug] == -1} {
24 return -1
25}
26
27# Start with a fresh gdb.
28
29gdb_exit
30gdb_start
31gdb_reinitialize_dir $srcdir/$subdir
32
33# Skip all tests if Guile scripting is not enabled.
34if { [skip_guile_tests] } { continue }
35
36gdb_install_guile_utils
37gdb_install_guile_module
38
39proc print_current_progspace { filename_regexp smob_filename_regexp } {
40 gdb_test "gu (print (progspace-filename (current-progspace)))" \
41 "= $filename_regexp" "current progspace filename"
42 gdb_test "gu (print (progspaces))" \
43 "= \\(#<gdb:progspace $smob_filename_regexp>\\)"
44}
45
46gdb_test "gu (print (progspace? 42))" "= #f"
47gdb_test "gu (print (progspace? (current-progspace)))" "= #t"
48
49with_test_prefix "at start" {
50 print_current_progspace "#f" "{no symfile}"
51}
52
53gdb_load ${binfile}
54
55with_test_prefix "program loaded" {
56 print_current_progspace ".*$testfile" ".*$testfile"
57 gdb_test_no_output "gu (define progspace (current-progspace))"
58 gdb_test "gu (print (progspace-valid? progspace))" "= #t"
59 gdb_test "gu (print (progspace-filename progspace))" "= .*$testfile"
60 gdb_test "gu (print (list? (progspace-objfiles progspace)))" "= #t"
61}
62
63# Verify we keep the same progspace when the program is unloaded.
64
65gdb_unload
66with_test_prefix "program unloaded" {
67 print_current_progspace "#f" "{no symfile}"
68 gdb_test "gu (print (eq? progspace (current-progspace)))" "= #t"
69}
70
71# Verify the progspace is garbage collected ok.
72# Note that when a program is unloaded, the associated progspace doesn't get
73# deleted. We need to, for example, delete an inferior to get the progspace
74# to go away.
75
121b3efd 76gdb_test "add-inferior" "Added inferior 2.*" "create new inferior"
cdc7edd7 77gdb_test "inferior 2" ".*" "switch to new inferior"
9f058c10 78gdb_test_no_output "remove-inferiors 1" "remove first inferior"
ded03782
DE
79
80with_test_prefix "inferior removed" {
81 gdb_test "gu (print (progspace-valid? progspace))" "= #f"
82 gdb_test "gu (print (progspace-filename progspace))" \
83 "ERROR:.*Invalid object.*"
84 gdb_test "gu (print (progspace-objfiles progspace))" \
85 "ERROR:.*Invalid object.*"
86 print_current_progspace "#f" "{no symfile}"
87}
88
89# garbage-collects can trigger segvs if we've messed up somewhere.
90
91gdb_test_no_output "gu (gc)"
92gdb_test "gu (print progspace)" "= #<gdb:progspace {invalid}>"
This page took 0.632506 seconds and 4 git commands to generate.