1# This testcase is part of GDB, the GNU debugger. 2 3# Copyright 2017-2020 Free Software Foundation, Inc. 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. 19if { [use_gdb_stub] } { 20 untested "not supported" 21 return 22} 23 24standard_testfile 25 26if { [prepare_for_testing "failed to prepare" $testfile $srcfile debug] } { 27 return -1 28} 29 30set 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 44proc 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 64proc 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 94proc 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 126with_test_prefix "long var value" { 127 do_test "this is my test variable; testing long vars; {}" 128} 129 130with_test_prefix "empty var" { 131 do_test "" 132} 133 134with_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 149proc 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 202with_test_prefix "test set/unset of vars" { 203 test_set_unset_vars 204} 205 206# Test that unsetting works. 207 208proc 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 253with_test_prefix "test unset of vars" { 254 test_unset 255} 256