# Copyright 2011-2023 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# This file was written by Pierre Muller
#
# Check if environment variables are correctly passed to inferiors
#
# Can't pass environment variables to the inferior if when we connect,
# the inferior is already running.
require !use_gdb_stub
standard_testfile .c
# Compile binary
# and start with a fresh gdb
if { [prepare_for_testing "failed to prepare" ${binfile} ${srcfile}] } {
return -1
}
# Test that the the inferior sees EXPECTED env vars starting with
# "TEST_GDB".
proc test_num_test_vars {expected message} {
set num [get_integer_valueof "j" -1 "$message, get num vars"]
gdb_assert {$num == $expected} "$message, confirmed"
}
set bp_line [gdb_get_line_number "set breakpoint here"]
gdb_breakpoint $bp_line
# Restart test program, and prepare for another test sequence.
# Returns true on success.
proc run_and_count_vars {} {
global srcfile bp_line
return [runto "$srcfile:$bp_line"]
}
# Find environment variable named VARNAME (peeking inferior variables
# directly), and return its value. Returns "" if not
# found.
proc find_env {varname} {
global gdb_prompt
for {set i 0} {1} {incr i} {
set test "printf \"var: %s\\n\", envp\[$i\] ? envp\[$i\] : \"\""
set var ""
gdb_test_multiple $test $test {
-re "var: \r\n$gdb_prompt $" {
return ""
}
-re "var: \(\[^\r\n\]*\)\r\n$gdb_prompt $" {
set var $expect_out(1,string)
}
-re "$gdb_prompt $" {
# If this fails, bail out, otherwise we get stuck in
# an infinite loop. The caller will end up emiting a
# FAIL.
return ""
}
}
if {[string match "$varname=*" $var]} {
set from [expr [string first "=" $var] + 1]
set to [string length $var]
return [string range $var $from $to]
}
}
}
#
# Test gdb set/unset environment commands.
# The executable lists and counts all environment variables
# starting with TEST_GDB.
proc_with_prefix test_set_unset_env {} {
global binfile
clean_restart $binfile
# First test with no TEST_GDB_VAR.
with_test_prefix "test1" {
if ![run_and_count_vars] {
return
}
test_num_test_vars 0 "no TEST_GDB vars"
}
# Second test with one TEST_GDB_VAR.
with_test_prefix "test2" {
gdb_test_no_output "set env TEST_GDB_VAR1 test1" \
"set TEST_GDB_VAR1"
if ![run_and_count_vars] {
return
}
test_num_test_vars 1 "one TEST_GDB var"
}
# Third test with two TEST_GDB_VAR.
with_test_prefix "test3" {
gdb_test_no_output "set env TEST_GDB_VAR2 test2" \
"set TEST_GDB_VAR2"
if ![run_and_count_vars] {
return
}
test_num_test_vars 2 "two TEST_GDB var"
}
# Fourth test with one TEST_GDB_VAR left, after one was removed
# with unset command.
with_test_prefix "test4" {
gdb_test_no_output "unset env TEST_GDB_VAR1" \
"unset TEST_GDB_VAR1"
if ![run_and_count_vars] {
return
}
test_num_test_vars 1 "one TEST_GDB var, after unset"
}
}
proc_with_prefix test_inherit_env_var {} {
global binfile
global bp_line
global env
# This test assumes that the build's environ (where dejagnu runs)
# is the same as the host's (where gdb runs) environ.
if [is_remote host] {
return
}
save_vars {env(TEST_GDB_GLOBAL)} {
set env(TEST_GDB_GLOBAL) "Global environment value"
clean_restart $binfile
gdb_breakpoint $bp_line
# First test with only inherited TEST_GDB_GLOBAL.
with_test_prefix "test1" {
if ![run_and_count_vars] {
return
}
gdb_test "show env" ".*TEST_GDB_GLOBAL=.*" \
"test passing TEST_GDB_GLOBAL to GDB"
test_num_test_vars 1 "TEST_GDB_GLOBAL"
set var [find_env "TEST_GDB_GLOBAL"]
gdb_assert {[string equal $var "Global environment value"]} \
"TEST_GDB_GLOBAL found with right value"
}
# Second test with one TEST_GDB_VAR.
with_test_prefix "test2" {
gdb_test_no_output "unset env TEST_GDB_GLOBAL" \
"unset TEST_GDB_GLOBAL"
if ![run_and_count_vars] {
return
}
test_num_test_vars 0 "TEST_GDB_GLOBAL is unset"
}
}
}
test_set_unset_env
test_inherit_env_var