1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
# Copyright 2011-2020 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# This file was written by Pierre Muller <muller@ics.u-strasbg.fr>
#
# Check if environment variables are correctly passed to inferiors
#
# Can't pass environment variables to the inferior if when we connect,
# the inferior is already running.
if [use_gdb_stub] {
return
}
standard_testfile .c
# Compile binary
# and start with a fresh gdb
if { [prepare_for_testing "failed to prepare" ${binfile} ${srcfile}] } {
return -1
}
# Test that the the inferior sees EXPECTED env vars starting with
# "TEST_GDB".
proc test_num_test_vars {expected message} {
set num [get_integer_valueof "j" -1 "$message, get num vars"]
gdb_assert {$num == $expected} "$message, confirmed"
}
set bp_line [gdb_get_line_number "set breakpoint here"]
gdb_breakpoint $bp_line
# Restart test program, and prepare for another test sequence.
# Returns true on success.
proc run_and_count_vars {} {
global srcfile bp_line
return [runto "$srcfile:$bp_line"]
}
# Find environment variable named VARNAME (peeking inferior variables
# directly), and return its value. Returns "<not found>" if not
# found.
proc find_env {varname} {
global gdb_prompt
for {set i 0} {1} {incr i} {
set test "printf \"var: %s\\n\", envp\[$i\] ? envp\[$i\] : \"\""
set var ""
gdb_test_multiple $test $test {
-re "var: \r\n$gdb_prompt $" {
return "<not found>"
}
-re "var: \(\[^\r\n\]*\)\r\n$gdb_prompt $" {
set var $expect_out(1,string)
}
}
if {[string match "$varname=*" $var]} {
set from [expr [string first "=" $var] + 1]
set to [string length $var]
return [string range $var $from $to]
}
}
}
#
# Test gdb set/unset environment commands.
# The executable lists and counts all environment variables
# starting with TEST_GDB.
proc_with_prefix test_set_unset_env {} {
global binfile
clean_restart $binfile
# First test with no TEST_GDB_VAR.
with_test_prefix "test1" {
if ![run_and_count_vars] {
return
}
test_num_test_vars 0 "no TEST_GDB vars"
}
# Second test with one TEST_GDB_VAR.
with_test_prefix "test2" {
gdb_test_no_output "set env TEST_GDB_VAR1 test1" \
"set TEST_GDB_VAR1"
if ![run_and_count_vars] {
return
}
test_num_test_vars 1 "one TEST_GDB var"
}
# Third test with two TEST_GDB_VAR.
with_test_prefix "test3" {
gdb_test_no_output "set env TEST_GDB_VAR2 test2" \
"set TEST_GDB_VAR2"
if ![run_and_count_vars] {
return
}
test_num_test_vars 2 "two TEST_GDB var"
}
# Fourth test with one TEST_GDB_VAR left, after one was removed
# with unset command.
with_test_prefix "test4" {
gdb_test_no_output "unset env TEST_GDB_VAR1" \
"unset TEST_GDB_VAR1"
if ![run_and_count_vars] {
return
}
test_num_test_vars 1 "one TEST_GDB var, after unset"
}
}
proc_with_prefix test_inherit_env_var {} {
global binfile
global bp_line
global env
# This test assumes that the build's environ (where dejagnu runs)
# is the same as the host's (where gdb runs) environ.
if [is_remote host] {
return
}
save_vars {env(TEST_GDB_GLOBAL)} {
set env(TEST_GDB_GLOBAL) "Global environment value"
clean_restart $binfile
gdb_breakpoint $bp_line
# First test with only inherited TEST_GDB_GLOBAL.
with_test_prefix "test1" {
if ![run_and_count_vars] {
return
}
gdb_test "show env" ".*TEST_GDB_GLOBAL=.*" \
"test passing TEST_GDB_GLOBAL to GDB"
test_num_test_vars 1 "TEST_GDB_GLOBAL"
set var [find_env "TEST_GDB_GLOBAL"]
gdb_assert {[string equal $var "Global environment value"]} \
"TEST_GDB_GLOBAL found with right value"
}
# Second test with one TEST_GDB_VAR.
with_test_prefix "test2" {
gdb_test_no_output "unset env TEST_GDB_GLOBAL" \
"unset TEST_GDB_GLOBAL"
if ![run_and_count_vars] {
return
}
test_num_test_vars 0 "TEST_GDB_GLOBAL is unset"
}
}
}
test_set_unset_env
test_inherit_env_var
|
