Commit | Line | Data |
---|---|---|
0a2dde4a SDJ |
1 | # This testcase is part of GDB, the GNU debugger. |
2 | ||
88b9d363 | 3 | # Copyright 2017-2022 Free Software Foundation, Inc. |
0a2dde4a SDJ |
4 | |
5 | # This program is free software; you can redistribute it and/or modify | |
6 | # it under the terms of the GNU General Public License as published by | |
7 | # the Free Software Foundation; either version 3 of the License, or | |
8 | # (at your option) any later version. | |
9 | # | |
10 | # This program is distributed in the hope that it will be useful, | |
11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | # GNU General Public License for more details. | |
14 | # | |
15 | # You should have received a copy of the GNU General Public License | |
16 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
17 | ||
18 | # This test doesn't make sense on native-gdbserver. | |
19 | if { [use_gdb_stub] } { | |
20 | untested "not supported" | |
21 | return | |
22 | } | |
23 | ||
24 | standard_testfile | |
25 | ||
26 | if { [prepare_for_testing "failed to prepare" $testfile $srcfile debug] } { | |
27 | return -1 | |
28 | } | |
29 | ||
30 | set test_var_name "GDB_TEST_VAR" | |
31 | ||
32 | # Helper function that performs a check on the output of "getenv". | |
33 | # | |
34 | # - VAR_NAME is the name of the variable to be checked. | |
35 | # | |
36 | # - VAR_VALUE is the value expected. | |
37 | # | |
38 | # - TEST_MSG, if not empty, is the test message to be used by the | |
39 | # "gdb_test". | |
40 | # | |
41 | # - EMPTY_VAR_P, if non-zero, means that the variable is not expected | |
42 | # to exist. In this case, VAR_VALUE is not considered. | |
43 | ||
44 | proc check_getenv { var_name var_value { test_msg "" } { empty_var_p 0 } } { | |
45 | global hex decimal | |
46 | ||
47 | if { $test_msg == "" } { | |
48 | set test_msg "print result of getenv for $var_name" | |
49 | } | |
50 | ||
51 | if { $empty_var_p } { | |
52 | set var_value_match "0x0" | |
53 | } else { | |
54 | set var_value_match "$hex \"$var_value\"" | |
55 | } | |
56 | ||
57 | gdb_test "print my_getenv (\"$var_name\")" "\\\$$decimal = $var_value_match" \ | |
58 | $test_msg | |
59 | } | |
60 | ||
61 | # Helper function to re-run to main and breaking at the "break-here" | |
62 | # label. | |
63 | ||
64 | proc do_prepare_inferior { } { | |
65 | global decimal hex | |
66 | ||
67 | if { ![runto_main] } { | |
68 | return -1 | |
69 | } | |
70 | ||
71 | gdb_breakpoint [gdb_get_line_number "break-here"] | |
72 | ||
73 | gdb_test "continue" "Breakpoint $decimal, main \\\(argc=1, argv=$hex\\\) at.*" \ | |
74 | "continue until breakpoint" | |
75 | } | |
76 | ||
77 | # Helper function that does the actual testing. | |
78 | # | |
79 | # - VAR_VALUE is the value of the environment variable. | |
80 | # | |
81 | # - VAR_NAME is the name of the environment variable. If empty, | |
82 | # defaults to $test_var_name. | |
83 | # | |
84 | # - VAR_NAME_MATCH is the name (regex) that will be used to query the | |
85 | # environment about the variable (via getenv). This is useful when | |
86 | # we're testing variables with strange names (e.g., with an equal | |
87 | # sign in the name) and we know that the variable will actually be | |
88 | # set using another name. If empty, defatults, to $var_name. | |
89 | # | |
90 | # - VAR_VALUE_MATCH is the value (regex) that will be used to match | |
91 | # the result of getenv. The rationale is the same as explained for | |
92 | # VAR_NAME_MATCH. If empty, defaults, to $var_value. | |
93 | ||
94 | proc do_test { var_value { var_name "" } { var_name_match "" } { var_value_match "" } } { | |
95 | global binfile test_var_name | |
96 | ||
97 | clean_restart $binfile | |
98 | ||
99 | if { $var_name == "" } { | |
100 | set var_name $test_var_name | |
101 | } | |
102 | ||
103 | if { $var_name_match == "" } { | |
104 | set var_name_match $var_name | |
105 | } | |
106 | ||
107 | if { $var_value_match == "" } { | |
108 | set var_value_match $var_value | |
109 | } | |
110 | ||
111 | if { $var_value != "" } { | |
112 | gdb_test_no_output "set environment $var_name = $var_value" \ | |
113 | "set $var_name = $var_value" | |
114 | } else { | |
115 | gdb_test "set environment $var_name =" \ | |
116 | "Setting environment variable \"$var_name\" to null value." \ | |
117 | "set $var_name to null value" | |
118 | } | |
119 | ||
120 | do_prepare_inferior | |
121 | ||
122 | check_getenv "$var_name_match" "$var_value_match" \ | |
123 | "print result of getenv for $var_name" | |
124 | } | |
125 | ||
126 | with_test_prefix "long var value" { | |
127 | do_test "this is my test variable; testing long vars; {}" | |
128 | } | |
129 | ||
130 | with_test_prefix "empty var" { | |
131 | do_test "" | |
132 | } | |
133 | ||
134 | with_test_prefix "strange named var" { | |
135 | # In this test we're doing the following: | |
136 | # | |
137 | # (gdb) set environment 'asd =' = 123 43; asd b ### [];;; | |
138 | # | |
139 | # However, due to how GDB parses this line, the environment | |
140 | # variable will end up named <'asd> (without the <>), and its | |
141 | # value will be <' = 123 43; asd b ### [];;;> (without the <>). | |
142 | do_test "123 43; asd b ### \[\];;;" "'asd ='" "'asd" \ | |
143 | [string_to_regexp "' = 123 43; asd b ### \[\];;;"] | |
144 | } | |
145 | ||
146 | # Test setting and unsetting environment variables in various | |
147 | # fashions. | |
148 | ||
149 | proc test_set_unset_vars { } { | |
150 | global binfile | |
151 | ||
152 | clean_restart $binfile | |
153 | ||
154 | with_test_prefix "set 3 environment variables" { | |
155 | # Set some environment variables | |
156 | gdb_test_no_output "set environment A = 1" \ | |
157 | "set A to 1" | |
158 | gdb_test_no_output "set environment B = 2" \ | |
159 | "set B to 2" | |
160 | gdb_test_no_output "set environment C = 3" \ | |
161 | "set C to 3" | |
162 | ||
163 | do_prepare_inferior | |
164 | ||
165 | # Check that the variables are known by the inferior | |
166 | check_getenv "A" "1" | |
167 | check_getenv "B" "2" | |
168 | check_getenv "C" "3" | |
169 | } | |
170 | ||
171 | with_test_prefix "unset one variable, reset one" { | |
172 | # Now, unset/reset some values | |
173 | gdb_test_no_output "unset environment A" \ | |
174 | "unset A" | |
175 | gdb_test_no_output "set environment B = 4" \ | |
176 | "set B to 4" | |
177 | ||
178 | do_prepare_inferior | |
179 | ||
180 | check_getenv "A" "" "" 1 | |
181 | check_getenv "B" "4" | |
182 | check_getenv "C" "3" | |
183 | } | |
184 | ||
185 | with_test_prefix "unset two variables, reset one" { | |
186 | # Unset more values | |
187 | gdb_test_no_output "unset environment B" \ | |
188 | "unset B" | |
189 | gdb_test_no_output "set environment A = 1" \ | |
190 | "set A to 1 again" | |
191 | gdb_test_no_output "unset environment C" \ | |
192 | "unset C" | |
193 | ||
194 | do_prepare_inferior | |
195 | ||
196 | check_getenv "A" "1" | |
197 | check_getenv "B" "" "" 1 | |
198 | check_getenv "C" "" "" 1 | |
199 | } | |
200 | } | |
201 | ||
202 | with_test_prefix "test set/unset of vars" { | |
203 | test_set_unset_vars | |
204 | } | |
205 | ||
206 | # Test that unsetting works. | |
207 | ||
208 | proc test_unset { } { | |
209 | global hex decimal binfile gdb_prompt | |
210 | ||
211 | clean_restart $binfile | |
212 | ||
213 | do_prepare_inferior | |
214 | ||
215 | set test_msg "check if unset works" | |
216 | set found_home 0 | |
217 | gdb_test_multiple "print my_getenv (\"HOME\")" $test_msg { | |
218 | -re "\\\$$decimal = $hex \".*\"\r\n$gdb_prompt $" { | |
219 | pass $test_msg | |
220 | set found_home 1 | |
221 | } | |
222 | -re "\\\$$decimal = 0x0\r\n$gdb_prompt $" { | |
223 | untested $test_msg | |
224 | } | |
225 | } | |
226 | ||
227 | if { $found_home == 1 } { | |
228 | with_test_prefix "simple unset" { | |
229 | # We can do the test, because $HOME exists (and therefore can | |
230 | # be unset). | |
231 | gdb_test_no_output "unset environment HOME" "unset HOME" | |
232 | ||
233 | do_prepare_inferior | |
234 | ||
235 | # $HOME now must be empty | |
236 | check_getenv "HOME" "" "" 1 | |
237 | } | |
238 | ||
239 | with_test_prefix "set-then-unset" { | |
240 | clean_restart $binfile | |
241 | ||
242 | # Test if setting and then unsetting $HOME works. | |
243 | gdb_test_no_output "set environment HOME = test" "set HOME as test" | |
244 | gdb_test_no_output "unset environment HOME" "unset HOME again" | |
245 | ||
246 | do_prepare_inferior | |
247 | ||
248 | check_getenv "HOME" "" "" 1 | |
249 | } | |
250 | } | |
251 | } | |
252 | ||
253 | with_test_prefix "test unset of vars" { | |
254 | test_unset | |
255 | } |