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