gdb/testsuite/gdb.base/testenv.exp

   1 # Copyright 2011-2019 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 # This file was written by Pierre Muller <muller@ics.u-strasbg.fr>
  17 #
  18 # Check if environment variables are correctly passed to inferiors
  19 #
  20
  21 # Can't pass environment variables to the inferior if when we connect,
  22 # the inferior is already running.
  23 if [use_gdb_stub] {
  24     return
  25 }
  26
  27 standard_testfile .c
  28
  29 # Compile binary
  30 # and start with a fresh gdb
  31
  32 if { [prepare_for_testing "failed to prepare" ${binfile} ${srcfile}] } {
  33      return -1
  34 }
  35
  36 # Test that the the inferior sees EXPECTED env vars starting with
  37 # "TEST_GDB".
  38 proc test_num_test_vars {expected message} {
  39     set num [get_integer_valueof "j" -1 "$message, get num vars"]
  40     gdb_assert {$num == $expected} "$message, confirmed"
  41 }
  42
  43 set bp_line [gdb_get_line_number "set breakpoint here"]
  44 gdb_breakpoint  $bp_line
  45
  46 # Restart test program, and prepare for another test sequence.
  47 # Returns true on success.
  48 proc run_and_count_vars {} {
  49     global srcfile bp_line
  50
  51     return [runto "$srcfile:$bp_line"]
  52 }
  53
  54 # Find environment variable named VARNAME (peeking inferior variables
  55 # directly), and return its value.  Returns "<not found>" if not
  56 # found.
  57
  58 proc find_env {varname} {
  59     global gdb_prompt
  60
  61     for {set i 0} {1} {incr i} {
  62         set test "printf \"var: %s\\n\", envp\[$i\] ? envp\[$i\] : \"\""
  63         set var ""
  64         gdb_test_multiple $test $test {
  65             -re "var: \r\n$gdb_prompt $" {
  66                 return "<not found>"
  67             }
  68             -re "var: \(\[^\r\n\]*\)\r\n$gdb_prompt $" {
  69                 set var $expect_out(1,string)
  70             }
  71         }
  72
  73         if {[string match "$varname=*" $var]} {
  74             set from [expr [string first "=" $var] + 1]
  75             set to [string length $var]
  76             return [string range $var $from $to]
  77         }
  78     }
  79 }
  80
  81 #
  82 # Test gdb set/unset environment commands.
  83 # The executable lists and counts all environment variables
  84 # starting with TEST_GDB.
  85
  86 proc_with_prefix test_set_unset_env {} {
  87     global binfile
  88
  89     clean_restart $binfile
  90
  91     # First test with no TEST_GDB_VAR.
  92     with_test_prefix "test1" {
  93         if ![run_and_count_vars] {
  94             return
  95         }
  96         test_num_test_vars 0 "no TEST_GDB vars"
  97     }
  98
  99     # Second test with one TEST_GDB_VAR.
 100     with_test_prefix "test2" {
 101         gdb_test_no_output "set env TEST_GDB_VAR1 test1" \
 102             "set TEST_GDB_VAR1"
 103
 104         if ![run_and_count_vars] {
 105             return
 106         }
 107         test_num_test_vars 1 "one TEST_GDB var"
 108     }
 109
 110     # Third test with two TEST_GDB_VAR.
 111     with_test_prefix "test3" {
 112         gdb_test_no_output "set env TEST_GDB_VAR2 test2" \
 113             "set TEST_GDB_VAR2"
 114
 115         if ![run_and_count_vars] {
 116             return
 117         }
 118
 119         test_num_test_vars 2 "two TEST_GDB var"
 120    }
 121
 122     # Fourth test with one TEST_GDB_VAR left, after one was removed
 123     # with unset command.
 124     with_test_prefix "test4" {
 125         gdb_test_no_output "unset env TEST_GDB_VAR1" \
 126             "unset TEST_GDB_VAR1"
 127
 128         if ![run_and_count_vars] {
 129             return
 130         }
 131
 132         test_num_test_vars 1 "one TEST_GDB var, after unset"
 133     }
 134 }
 135
 136 proc_with_prefix test_inherit_env_var {} {
 137     global binfile
 138     global bp_line
 139     global env
 140
 141     # This test assumes that the build's environ (where dejagnu runs)
 142     # is the same as the host's (where gdb runs) environ.
 143     if [is_remote host] {
 144         return
 145     }
 146
 147     save_vars {env(TEST_GDB_GLOBAL)} {
 148         set env(TEST_GDB_GLOBAL) "Global environment value"
 149
 150         clean_restart $binfile
 151
 152         gdb_breakpoint $bp_line
 153
 154         # First test with only inherited TEST_GDB_GLOBAL.
 155         with_test_prefix "test1" {
 156             if ![run_and_count_vars] {
 157                 return
 158             }
 159
 160             gdb_test "show env" ".*TEST_GDB_GLOBAL=.*" \
 161                 "test passing TEST_GDB_GLOBAL to GDB"
 162
 163             test_num_test_vars 1 "TEST_GDB_GLOBAL"
 164
 165             set var [find_env "TEST_GDB_GLOBAL"]
 166
 167             gdb_assert {[string equal $var "Global environment value"]} \
 168                 "TEST_GDB_GLOBAL found with right value"
 169         }
 170
 171         # Second test with one TEST_GDB_VAR.
 172         with_test_prefix "test2" {
 173             gdb_test_no_output "unset env TEST_GDB_GLOBAL" \
 174                 "unset TEST_GDB_GLOBAL"
 175
 176             if ![run_and_count_vars] {
 177                 return
 178             }
 179
 180             test_num_test_vars 0 "TEST_GDB_GLOBAL is unset"
 181         }
 182     }
 183 }
 184
 185 test_set_unset_env
 186 test_inherit_env_var