binutils-gdb/gdb/testsuite/gdb.base/testenv.exp

# Copyright 2011-2022 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 <http://www.gnu.org/licenses/>.

# This file was written by Pierre Muller <muller@ics.u-strasbg.fr>
#
# 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.
if [use_gdb_stub] {
    return
}

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 "<not found>" 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 "<not found>"
	    }
	    -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 "<fail>"
	    }
	}

	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