gdb/testsuite/gdb.base/args.exp

# Copyright 2003-2025 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 is a test for the gdb invocation option --args.

# Skip test if target does not support argument passing.
require {!target_info exists noargs}

# This test requires starting new inferior processes, skip it if the target
# board is a stub.
require !use_gdb_stub
require {expr [have_startup_shell] != -1}

standard_testfile

if {[build_executable $testfile.exp $testfile $srcfile] == -1} {
    untested "failed to compile"
    return -1
}

# Assuming a running GDB.  Check the status of the single inferior
# argument feature.  When this feature is on GDB passes inferior
# arguments as a single combined string.  When this feature is off GDB
# will split the inferior arguments into multiple separate strings.
#
# Return true when arguments are being split, or false when a single
# combined string is being sent.

proc is_argument_splitting_on {} {
    set arg_splitting true

    gdb_test_multiple "show remote single-inferior-argument-feature-packet" "" {
	-re -wrap "Support for the 'single-inferior-argument-feature' packet on the current remote target is \"(on|off)\"\\.(.*)" {
	    set value $expect_out(1,string)
	    pass $gdb_test_name
	    if { $value eq "on" } {
		set arg_splitting false
	    }
	}
	-re -wrap "Support for the 'single-inferior-argument-feature' packet on the current remote target is \"auto\", currently (enabled|disabled)\\.(.*)" {
	    set value $expect_out(1,string)
	    pass $gdb_test_name
	    if { $value eq "enabled" } {
		set arg_splitting false
	    }
	}
    }

    return $arg_splitting
}

# NAME is the name to use for the tests and ARGLIST is the list of
# arguments that are passed to GDB when it is started.
#
# The optional RE_ESC_LIST is the list of patterns to check the
# inferior arguments against when GDB is started using --args.  If
# RE_ESC_LIST is not given then ARGLIST is reused, this implies that
# the inferior arguments appear unchanged in the test output.
#
# The optional RE_NO_ESC_LIST is the list of patterns to check the
# inferior arguments against when GDB is started using
# --no-escape-args.  If RE_NO_ESC_LIST is not given then RE_ESC_LIST
# is reused, this implies that there's no difference between the test
# output when the arguments are escaped or not.

proc args_test { name arglist {re_esc_list {}} {re_no_esc_list {}} } {

    # If either of the two regexp lists are not specificed then we can
    # use an earlier argument value instead.
    #
    # For the first regexp list, if this is missing then we use the
    # argument list, this assumes that the arguments will appear
    # unmodified in the output.
    if {[llength $re_esc_list] == 0} {
	set re_esc_list $arglist
    }

    # If the second regexp list is missing then we reuse the first
    # regexp list.  This assumes there's no difference between escaped
    # and unescaped arguments in the output.
    if {[llength $re_no_esc_list] == 0} {
	set re_no_esc_list $re_esc_list
    }

    foreach_with_prefix startup_with_shell { on off } {
	foreach_with_prefix arg_flag { args no-escape-args } {
	    save_vars { ::GDBFLAGS } {
		set ::GDBFLAGS "$::GDBFLAGS --${arg_flag} $::binfile $arglist"

		clean_restart $::testfile

		gdb_test_no_output \
		    "set startup-with-shell ${startup_with_shell}" \
		    "set startup-with-shell for $name"

		runto_main
		gdb_breakpoint [gdb_get_line_number "set breakpoint here"]
		gdb_continue_to_breakpoint "breakpoint for $name"

		if { $arg_flag eq "args" || $startup_with_shell eq "off" } {
		    set re_list $re_esc_list
		} else {
		    set re_list $re_no_esc_list
		}

		set expected_len [expr 1 + [llength $re_list]]
		gdb_test "print argc" \
		    "\\\$$::decimal = $expected_len" "argc for $name"

		set i 1
		foreach arg $re_list {
		    if { $arg eq "\n" } {
			set arg {\\n}
		    } elseif { $arg eq "\"" } {
			set arg {\\\"}
		    }

		    # If we are starting with a shell, we're not escaping
		    # special shell characters in arguments passed to GDB,
		    # we're using a remote target, and the arguments contain
		    # a shell variable (indicated with a '$'), then this
		    # test will currently fail if we are splitting the
		    # arguments.
		    if { $startup_with_shell eq "on"
			 && $arg_flag eq "no-escape-args"
			 && [gdb_protocol_is_remote]
			 && [string first "\$" $arglist] != -1
			 && [is_argument_splitting_on] } {
			setup_xfail "*-*-*" gdb/28392
		    }

		    gdb_test "print argv\[$i\]" \
			"\\\$$::decimal = $::hex \"$arg\"" \
			"argv\[$i\] for $name"
		    set i [expr $i + 1]
		}
	    }
	}
    }
}

# Run all the tests.
proc run_all_tests {} {
    # Test that the --args are processed correctly.

    args_test basic {{1} {3}}

    # Test that the --args are processed correctly even if one of them is
    # empty.

    args_test "one empty" {{1} {} {3}}

    # Try with 2 empty args.

    args_test "two empty" {{1} {} {} 3}

    # Try with arguments containing literal single quotes.

    args_test "one empty with single quotes" {{1} {''} {3}}

    args_test "two empty with single quotes" {{1} {''} {''} {3}}

    # Try with arguments containing literal newlines.

    args_test "one newline" {{1} "\n" {3}} {1 \\\\n 3}

    args_test "two newlines" {{1} "\n" "\n" {3}} {1 \\\\n \\\\n 3}

    args_test "lone single quote" {{1} \' {3}}

    args_test "lone double quote" {{1} \" {3}} {1 \\\\\" 3}

    save_vars { ::env(TEST) } {
	set ::env(TEST) "ABCD"
	args_test "shell variable" {{$TEST}} {\\$TEST} {{ABCD}}
    }

    # At one point we had a bug where, if the last inferior argument,
    # appearing after --args, looked like an option GDB might be able
    # to process, e.g. started with a dash, then GDB would try to
    # process it.  This would leave GDB in a broken state, and so GDB
    # would fail to start.  A example of a failing GDB command line:
    # $ gdb --args /bin/ls --all
    foreach_with_prefix flag { args no-escape-args } {
	args_test "with trailing GDB flag" [list "--${flag}"]
    }
    args_test "with trailing GDB option and value" [list "--ex" "start"]
    args_test "with trailing double dash option" [list "--foo"]
    args_test "with trailing single dash option" [list "-foo"]
}

run_all_tests

# For extended-remote targets, disable the packet which passes
# inferior arguments as a single string.  This changes how the vRun
# (extended-remote only) packet works.
if {[target_info gdb_protocol] == "extended-remote"} {
    with_test_prefix "single-inferior-arg disabled" {
	save_vars { GDBFLAGS } {
	    append GDBFLAGS " -ex \"set remote single-inferior-argument-feature-packet off\""
	    run_all_tests
	}
    }
}