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

   1 # This testcase is part of GDB, the GNU debugger.
   2
   3 # Copyright 2017-2019 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 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 }