gdb/testsuite/gdb.multi/multi-target.exp

# Copyright 2017-2020 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/>.

# Test multi-target features.

load_lib gdbserver-support.exp

if { [skip_gdbserver_tests] } {
    return 0
}

standard_testfile

# The plain remote target can't do multiple inferiors.
if {[target_info gdb_protocol] != ""} {
    return
}

if { [prepare_for_testing "failed to prepare" ${binfile} "${srcfile}" \
	  {debug pthreads}] } {
    return
}

# Keep a list of (inferior ID, spawn ID).
set server_spawn_ids [list]

proc connect_target_extended_remote {binfile num} {
    set res [gdbserver_start "--multi" ""]
    global server_spawn_ids server_spawn_id
    lappend server_spawn_ids $num $server_spawn_id
    set gdbserver_gdbport [lindex $res 1]
    return [gdb_target_cmd "extended-remote" $gdbserver_gdbport]
}

# Add and start inferior number NUM.  Returns true on success, false
# otherwise.
proc add_inferior {num target binfile {gcorefile ""}} {
    # Start another inferior.
    gdb_test "add-inferior -no-connection" "Added inferior $num" \
	"add empty inferior $num"
    gdb_test "inferior $num" "Switching to inferior $num.*" \
	"switch to inferior $num"
    gdb_test "file ${binfile}" ".*" "load file in inferior $num"
    gdb_test_no_output "set remote exec-file ${binfile}" \
	"set remote-exec file in inferior $num"

    if {$target == "core"} {
	gdb_test "core $gcorefile" "Core was generated by.*" \
	    "core [file tail $gcorefile], inf $num"
	return 1
    }

    if {$target == "extended-remote"} {
	if {[connect_target_extended_remote $binfile $num]} {
	    return 0
	}
    }
    if ![runto "all_started"] then {
	return 0
    }
    delete_breakpoints

    return 1
}

proc prepare_core {} {
    global gcorefile gcore_created
    global binfile

    clean_restart ${binfile}

    if ![runto all_started] then {
	return -1
    }

    global testfile
    set gcorefile [standard_output_file $testfile.gcore]
    set gcore_created [gdb_gcore_cmd $gcorefile "save a core file"]
}

proc next_live_inferior {inf} {
    incr inf
    if {$inf == 3} {
	# 3 is a core.
	return 4
    }
    if {$inf > 5} {
	# 6 is a core.
	return 1
    }

    return $inf
}

# Clean up the server_spawn_ids.
proc cleanup_gdbservers { } {
    global server_spawn_id
    global server_spawn_ids
    foreach { inferior_id spawn_id } $server_spawn_ids {
	set server_spawn_id $spawn_id
	gdb_test "inferior $inferior_id"
	gdbserver_exit 0
    }
    set server_spawn_ids [list]
}

# Return true on success, false otherwise.

proc setup {non-stop} {
    global gcorefile gcore_created
    global binfile

    cleanup_gdbservers
    clean_restart ${binfile}

    # multi-target depends on target running in non-stop mode.  Force
    # it on for remote targets, until this is the default.
    gdb_test_no_output "maint set target-non-stop on"

    gdb_test_no_output "set non-stop ${non-stop}"

    if ![runto all_started] then {
	return 0
    }

    delete_breakpoints

    # inferior 1 -> native
    # inferior 2 -> extended-remote
    # inferior 3 -> core
    # inferior 4 -> native
    # inferior 5 -> extended-remote
    # inferior 6 -> core
    if {![add_inferior 2 "extended-remote" $binfile]} {
	return 0
    }
    if {![add_inferior 3 "core" $binfile $gcorefile]} {
	return 0
    }
    if {![add_inferior 4 "native" $binfile]} {
	return 0
    }
    if {![add_inferior 5 "extended-remote" $binfile]} {
	return 0
    }
    if {![add_inferior 6 "core" $binfile $gcorefile]} {
	return 0
    }

    # For debugging.
    gdb_test "info threads" ".*"

    # Make "continue" resume all inferiors.
    if {${non-stop} == "off"} {
	gdb_test_no_output "set schedule-multiple on"
    }

    return 1
}

# Test "continue" to breakpoints in different targets.  In non-stop
# mode, also tests "interrupt -a".
proc test_continue {non-stop} {
    if {![setup ${non-stop}]} {
	untested "setup failed"
	return
    }

    proc set_break {inf} {
	gdb_test "break function${inf} thread ${inf}.1" \
	"Breakpoint .* function${inf}\\..*"
    }

    # Select inferior INF, and then run to a breakpoint on inferior
    # INF+1.
    proc test_continue_inf {inf} {
	upvar 1 non-stop non-stop

	global gdb_prompt
	delete_breakpoints

	set next_inf [next_live_inferior $inf]

	gdb_test "inferior $inf" "Switching to inferior $inf.*"
	set_break $next_inf

	if {${non-stop} == "off"} {
	    gdb_test "continue" "hit Breakpoint .* function${next_inf}.*"
	} else {
	    set msg "continue"
	    gdb_test_multiple "continue -a&" $msg {
		-re "Continuing.*$gdb_prompt " {
		    pass $msg
		}
	    }

	    set msg "hit bp"
	    gdb_test_multiple "" $msg {
		-re "hit Breakpoint .* function${next_inf}" {
		    pass $msg
		}
	    }

	    set msg "stop all threads"
	    gdb_test_multiple "interrupt -a" $msg {
		-re "$gdb_prompt " {
		    for {set i 0} {$i < 7} {incr i} {
			set ok 0
			gdb_test_multiple "" $msg {
			    -re "Thread\[^\r\n\]*stopped\\." {
				set ok 1
			    }
			}
			if {!$ok} {
			    break
			}
		    }
		    gdb_assert $ok $msg
		}
	    }
	}
    }

    for {set i 1} {$i <= 5} {incr i} {
	if {$i == 3} {
	    # This is a core inferior.
	    continue
	}

	with_test_prefix "inf$i" {
	    test_continue_inf $i
	}
    }
}

# Test interrupting multiple targets with Ctrl-C.

proc test_ctrlc {} {
    if {![setup "off"]} {
	untested "setup failed"
	return
    }

    delete_breakpoints

    # Select inferior INF, continue all inferiors, and then Ctrl-C.
    proc test_ctrlc_inf {inf} {
	global gdb_prompt

	gdb_test "inferior $inf" "Switching to inferior $inf.*"

	set msg "continue"
	gdb_test_multiple "continue" $msg {
	    -re "Continuing" {
		pass $msg
	    }
	}

	after 200 { send_gdb "\003" }

	set msg "send_gdb control C"
	gdb_test_multiple "" $msg {
	    -re "received signal SIGINT.*$gdb_prompt $" {
		pass $msg
	    }
	}

	set msg "all threads stopped"
	gdb_test_multiple "info threads" "$msg" {
	    -re "\\\(running\\\).*$gdb_prompt $" {
		fail $msg
	    }
	    -re "$gdb_prompt $" {
		pass $msg
	    }
	}
    }

    for {set i 1} {$i <= 5} {incr i} {
	if {$i == 3} {
	    # This is a core inferior.
	    continue
	}

	with_test_prefix "inf$i" {
	    test_ctrlc_inf $i
	}
    }
}

# Test "next" bouncing between two breakpoints in two threads running
# in different targets.
proc test_ping_pong_next {} {
    global srcfile

    if {![setup "off"]} {
	untested "setup failed"
	return
    }

    # block/unblock inferiors 1 and 2 according to INF1 and INF2.
    proc block {inf1 inf2} {
	gdb_test "thread apply 1.1 p wait_for_gdb = $inf1" " = $inf1"
	gdb_test "thread apply 2.1 p wait_for_gdb = $inf2" " = $inf2"
    }

    # We're use inferiors 1 and 2.  Make sure they're really connected
    # to different targets.
    gdb_test "thread apply 1.1 maint print target-stack" \
	"- native.*"
    gdb_test "thread apply 2.1 maint print target-stack" \
	"- extended-remote.*"

    # Set two breakpoints, one for each of inferior 1 and 2.  Inferior
    # 1 is running on the native target, and inferior 2 is running on
    # extended-gdbserver.  Run to breakpoint 1 to gets things started.
    set line1 [gdb_get_line_number "set break 1 here"]
    set line2 [gdb_get_line_number "set break 2 here"]

    gdb_test "thread 1.1" "Switching to thread 1.1 .*"

    gdb_test "break $srcfile:$line1 thread 1.1" \
	"Breakpoint .*$srcfile:$line1\\..*"

    gdb_test "continue" "hit Breakpoint .*"

    gdb_test "break $srcfile:$line2 thread 2.1" \
	"Breakpoint .*$srcfile:$line2\\..*"

    # Now block inferior 1 and issue "next".  We should stop at the
    # breakpoint for inferior 2, given schedlock off.
    with_test_prefix "next inf 1" {
	block 1 0
	gdb_test "next" "Thread 2.1 .*hit Breakpoint .*$srcfile:$line2.*"
    }

    # Now unblock inferior 2 and block inferior 1.  "next" should run
    # into the breakpoint in inferior 1.
    with_test_prefix "next inf 2" {
	block 0 1
	gdb_test "next" "Thread 1.1 .*hit Breakpoint .*$srcfile:$line1.*"
    }

    # Try nexting inferior 1 again.
    with_test_prefix "next inf 1 again" {
	block 1 0
	gdb_test "next" "Thread 2.1 .*hit Breakpoint .*$srcfile:$line2.*"
    }
}

# Test "info inferiors" and "info connections".  MULTI_PROCESS
# indicates whether the multi-process feature of remote targets is
# turned off or on.
proc test_info_inferiors {multi_process} {
    setup "off"

    gdb_test_no_output \
	"set remote multiprocess-feature-packet $multi_process"

    # Get the description for inferior INF for when the current
    # inferior id is CURRENT.
    proc inf_desc {inf current} {
	set ws "\[ \t\]+"
	global decimal
	upvar multi_process multi_process

	if {($multi_process == "off") && ($inf == 2 || $inf == 5)} {
	    set desc "Remote target"
	} else {
	    set desc "process ${decimal}"
	}

	set desc "${inf}${ws}${desc}${ws}"
	if {$inf == $current} {
	    return "\\* $desc"
	} else {
	    return "  $desc"
	}
    }

    # Get the "Num" column for CONNECTION for when the current
    # inferior id is CURRENT_INF.
    proc connection_num {connection current_inf} {
	switch $current_inf {
	    "4" { set current_connection "1"}
	    "5" { set current_connection "4"}
	    "6" { set current_connection "5"}
	    default { set current_connection $current_inf}
	}
	if {$connection == $current_connection} {
	    return "\\* $connection"
	} else {
	    return "  $connection"
	}
    }

    set ws "\[ \t\]+"
    global decimal binfile

    # Test "info connections" and "info inferior" by switching to each
    # inferior one by one.
    for {set inf 1} {$inf <= 6} {incr inf} {
	with_test_prefix "inferior $inf" {
	    gdb_test "inferior $inf" "Switching to inferior $inf.*"

	    gdb_test "info connections" \
		[multi_line \
		     "Num${ws}What${ws}Description${ws}" \
		     "[connection_num 1 $inf]${ws}native${ws}Native process${ws}" \
		     "[connection_num 2 $inf]${ws}extended-remote localhost:$decimal${ws}Extended remote serial target in gdb-specific protocol${ws}" \
		     "[connection_num 3 $inf]${ws}core${ws}Local core dump file${ws}" \
		     "[connection_num 4 $inf]${ws}extended-remote localhost:$decimal${ws}Extended remote serial target in gdb-specific protocol${ws}" \
		     "[connection_num 5 $inf]${ws}core${ws}Local core dump file${ws}" \
		    ]

	    gdb_test "info inferiors" \
		[multi_line \
		     "Num${ws}Description${ws}Connection${ws}Executable${ws}" \
		     "[inf_desc 1 $inf]1 \\(native\\)${ws}${binfile}${ws}" \
		     "[inf_desc 2 $inf]2 \\(extended-remote localhost:$decimal\\)${ws}${binfile}${ws}" \
		     "[inf_desc 3 $inf]3 \\(core\\)${ws}${binfile}${ws}" \
		     "[inf_desc 4 $inf]1 \\(native\\)${ws}${binfile}${ws}" \
		     "[inf_desc 5 $inf]4 \\(extended-remote localhost:$decimal\\)${ws}${binfile}${ws}" \
		     "[inf_desc 6 $inf]5 \\(core\\)${ws}${binfile}${ws}" \
		    ]
	}
    }
}

# Test that when there's a foreground execution command in progress, a
# TARGET_WAITKIND_NO_RESUMED for a particular target is ignored when
# other targets are still resumed.

proc test_no_resumed {} {
    proc test_no_resumed_infs {inf_A inf_B} {
	global gdb_prompt

	if {![setup "off"]} {
	    untested "setup failed"
	    return
	}

	gdb_test "thread $inf_A.2" "Switching to thread $inf_A\.2 .*" \
	    "select thread of target A"

	gdb_test_no_output "set scheduler-locking on"

	gdb_test_multiple "continue &" "" {
	    -re "Continuing.*$gdb_prompt " {
		pass $gdb_test_name
	    }
	}

	gdb_test "thread $inf_B.2" "Switching to thread $inf_B\.2 .*" \
	    "select thread of target B"
	gdb_test "p exit_thread = 1" " = 1" \
	    "set the thread to exit on resumption"

	# Wait 3 seconds.  If we see any response from GDB, such as
	# "No unwaited-for children left." it's a bug.
	gdb_test_multiple "continue" "continue" {
	    -timeout 3
	    timeout {
		pass $gdb_test_name
	    }
	}

	# Now stop the program (all targets).
	send_gdb "\003"
	gdb_test_multiple "" "send_gdb control C" {
	    -re "received signal SIGINT.*$gdb_prompt $" {
		pass $gdb_test_name
	    }
	}

	gdb_test_multiple "info threads" "all threads stopped" {
	    -re "\\\(running\\\).*$gdb_prompt $" {
		fail $gdb_test_name
	    }
	    -re "$gdb_prompt $" {
		pass $gdb_test_name
	    }
	}
    }

    # inferior 1 -> native
    # inferior 2 -> extended-remote 1
    # inferior 5 -> extended-remote 2
    set inferiors {1 2 5}
    foreach_with_prefix inf_A $inferiors {
	foreach_with_prefix inf_B $inferiors {
	    if {$inf_A == $inf_B} {
		continue
	    }
	    test_no_resumed_infs $inf_A $inf_B
	}
    }
}


# Make a core file with two threads upfront.  Several tests load the
# same core file.
prepare_core

# Some basic "continue" + breakpoints tests.
with_test_prefix "continue" {
    foreach_with_prefix non-stop {"off" "on"} {
	test_continue ${non-stop}
    }
}

# Some basic all-stop Ctrl-C tests.
with_test_prefix "interrupt" {
    test_ctrlc
}

# Test ping-ponging between two targets with "next".
with_test_prefix "ping-pong" {
    test_ping_pong_next
}

# Test "info inferiors" and "info connections" commands.
with_test_prefix "info-inferiors" {
    foreach_with_prefix multi_process {"on" "off"} {
	test_info_inferiors $multi_process
    }
}

# Test TARGET_WAITKIND_NO_RESUMED handling with multiple targets.
with_test_prefix "no-resumed" {
    test_no_resumed
}

cleanup_gdbservers