gdb/testsuite/gdb.base/share-env-with-gdbserver.exp

   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 }