[thirdparty/binutils-gdb.git] / gdb / testsuite / gdb.base / foll-fork.exp

#   Copyright 1997-2021 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 relies on checking follow-fork output. Do not run if gdb debug is
# enabled as it will be redirected to the log.
if [gdb_debug_enabled] {
    untested "debug is enabled"
    return 0
}

standard_testfile

if {[build_executable "failed to prepare" $testfile $srcfile debug]} {
    return -1
}

# Restart GDB and run the inferior to main.  Return 1 on success, 0 on failure.

proc setup {} {
    clean_restart $::testfile

    if { ![runto_main] } {
	fail "could not run to main"
	return 0
    }

    return 1
}

# Check that fork catchpoints are supported, as an indicator for whether
# fork-following is supported.  Return 1 if they are, else 0.

proc_with_prefix check_fork_catchpoints {} {
  global gdb_prompt

  if { ![setup] } {
      return
  }

  # Verify that the system supports "catch fork".
  gdb_test "catch fork" "Catchpoint \[0-9\]* \\(fork\\)" "insert first fork catchpoint"
  set has_fork_catchpoints 0
  gdb_test_multiple "continue" "continue to first fork catchpoint" {
    -re ".*Your system does not support this type\r\nof catchpoint.*$gdb_prompt $" {
      unsupported "continue to first fork catchpoint"
    }
    -re ".*Catchpoint.*$gdb_prompt $" {
      set has_fork_catchpoints 1
      pass "continue to first fork catchpoint"
    }
  }

  return $has_fork_catchpoints
}

# Test follow-fork to ensure that the correct process is followed, that
# the followed process stops where it is expected to stop, that processes
# are detached (or not) as expected, and that the inferior list has the
# expected contents after following the fork.  WHO is the argument to
# the 'set follow-fork-mode' command, DETACH is the argument to the 
# 'set detach-on-fork' command, and CMD is the GDB command used to 
# execute the program past the fork.  If the value of WHO or DETACH is
# 'default', the corresponding GDB command is skipped for that test.
# The value of CMD must be either 'next 2' or 'continue'.
proc_with_prefix test_follow_fork { who detach cmd } {
    global gdb_prompt
    global srcfile
    global testfile

    with_test_prefix "follow $who, detach $detach, command \"$cmd\"" {

	# Start a new debugger session each time so defaults are legitimate.
	if { ![setup] } {
	    return
	}

	# The "Detaching..." and "Attaching..." messages may be hidden by
	# default.
	gdb_test_no_output "set verbose"

	# Set follow-fork-mode if we aren't using the default.
	if {$who == "default"} {
	    set who "parent"
	} else {
	    gdb_test_no_output "set follow-fork $who"
	}

	gdb_test "show follow-fork" \
	"Debugger response to a program call of fork or vfork is \"$who\"."

	# Set detach-on-fork mode if we aren't using the default.
	if {$detach == "default"} {
	    set detach "on"
	} else {
	    gdb_test_no_output "set detach-on-fork $detach"
	}

	gdb_test "show detach-on-fork" \
		 "Whether gdb will detach.* fork is $detach."

	# Set a breakpoint after the fork if we aren't single-stepping
	# past the fork.
	if {$cmd == "continue"} {
	    set bp_after_fork [gdb_get_line_number "set breakpoint here"]
	    gdb_test "break ${srcfile}:$bp_after_fork" \
		     "Breakpoint.*, line $bp_after_fork.*" \
		     "set breakpoint after fork"
	}

	# Set up the output we expect to see after we run.
	set expected_re ""
	if {$who == "child"} {
	    set expected_re "\\\[Attaching after.* fork to.*"
	    if {$detach == "on"} {
		append expected_re "\\\[Detaching after fork from .*"
	    }
	    append expected_re "set breakpoint here.*"
	} elseif {$who == "parent" && $detach == "on"} {
	    set expected_re "\\\[Detaching after fork from .*set breakpoint here.*"
	} else {
	    set expected_re ".*set breakpoint here.*"
	}

	# Test running past and following the fork, using the parameters
	# set above.
	gdb_test $cmd $expected_re "$cmd past fork"

	# Check that we have the inferiors arranged correctly after 
	# following the fork.
	set resume_unfollowed 0
	if {$who == "parent" && $detach == "on"} {

	    # Follow parent / detach child: the only inferior is the parent.
	    gdb_test "info inferiors" "\\* 1 .* process.*"

	} elseif {$who == "parent" && $detach == "off"} {

	    # Follow parent / keep child: two inferiors under debug, the
	    # parent is the current inferior.
	    gdb_test "info inferiors" "\\* 1 .*process.* 2 .*process.*"

	    gdb_test "inferior 2" "Switching to inferior 2 .*"
	    set resume_unfollowed 1

	} elseif {$who == "child" && $detach == "on"} {

	    # Follow child / detach parent: the child is under debug and is
	    # the current inferior.  The parent is listed but is not under
	    # debug.
	    gdb_test "info inferiors" " 1 .*<null>.*\\* 2 .*process.*"

	} elseif {$who == "child" && $detach == "off"} {

	    # Follow child / keep parent: two inferiors under debug, the
	    # child is the current inferior.
	    gdb_test "info inferiors" " 1 .*process.*\\* 2 .*process.*"

	    gdb_test "inferior 1" "Switching to inferior 1 .*"
	    set resume_unfollowed 1
	}

	if {$resume_unfollowed == 1} {
	    if {$cmd == "next 2"} {

		gdb_continue_to_end "continue unfollowed inferior to end"

	    } elseif {$cmd == "continue"} {

		gdb_continue_to_breakpoint \
		    "continue unfollowed inferior to bp" \
		    ".* set breakpoint here.*"
	    }
	}
    }
}

set reading_in_symbols_re {(?:\r\nReading in symbols for [^\r\n]*)?}

# Test the ability to catch a fork, specify that the child be
# followed, and continue.  Make the catchpoint permanent.

proc_with_prefix catch_fork_child_follow {} {
    global gdb_prompt
    global srcfile
    global reading_in_symbols_re

    if { ![setup] } {
	return
    }

    set bp_after_fork [gdb_get_line_number "set breakpoint here"]

    gdb_test "catch fork" \
	"Catchpoint \[0-9\]* \\(fork\\)$reading_in_symbols_re" \
	"explicit child follow, set catch fork"

    # Verify that the catchpoint is mentioned in an "info breakpoints",
    # and further that the catchpoint mentions no process id.
    gdb_test "info breakpoints" \
	".*catchpoint.*keep y.*fork\[\r\n\]+" \
	"info breakpoints before fork"

    gdb_test "continue" \
	"Catchpoint \[0-9\]* \\(forked process \[0-9\]*\\),.*" \
	"explicit child follow, catch fork"

    # Verify that the catchpoint is mentioned in an "info breakpoints",
    # and further that the catchpoint managed to capture a process id.
    gdb_test "info breakpoints" \
	".*catchpoint.*keep y.*fork, process.*" \
	"info breakpoints after fork"

    gdb_test_no_output "set follow-fork child"

    gdb_test "tbreak ${srcfile}:$bp_after_fork" \
	"Temporary breakpoint.*, line $bp_after_fork.*" \
	"set follow-fork child, tbreak"

    set expected_re "\\\[Attaching after.* fork to.*\\\[Detaching after fork from"
    append expected_re ".* at .*$bp_after_fork.*"
    gdb_test "continue" $expected_re "set follow-fork child, hit tbreak"

    # The parent has been detached; allow time for any output it might
    # generate to arrive, so that output doesn't get confused with
    # any expected debugger output from a subsequent testpoint.
    #
    exec sleep 1

    gdb_test "delete breakpoints" \
	"" \
	"set follow-fork child, cleanup" \
	"Delete all breakpoints. \\(y or n\\) $" \
	"y"
}

# Test that parent breakpoints are successfully detached from the
# child at fork time, even if the user removes them from the
# breakpoints list after stopping at a fork catchpoint.

proc_with_prefix catch_fork_unpatch_child {} {
    global gdb_prompt
    global srcfile

    if { ![setup] } {
	return
    }

    set bp_exit [gdb_get_line_number "at exit"]

    gdb_test "break callee" "file .*$srcfile, line .*" \
	"unpatch child, break at callee"
    gdb_test "catch fork" "Catchpoint \[0-9\]* \\(fork\\)" \
	"unpatch child, set catch fork"

    gdb_test "continue" \
	"Catchpoint \[0-9\]* \\(forked process \[0-9\]*\\),.*" \
	"unpatch child, catch fork"

    # Delete all breakpoints and catchpoints.
    delete_breakpoints

    # Force $srcfile as the current GDB source can be in glibc sourcetree.
    gdb_test "break $srcfile:$bp_exit" \
	"Breakpoint .*file .*$srcfile, line .*" \
	"unpatch child, breakpoint at exit call"

    gdb_test_no_output "set follow-fork child" \
	"unpatch child, set follow-fork child"

    set test "unpatch child, unpatched parent breakpoints from child"
    gdb_test_multiple "continue" $test {
	-re "at exit.*$gdb_prompt $" {
	    pass "$test"
	}
	-re "SIGTRAP.*$gdb_prompt $" {
	    fail "$test"

	    # Explicitly kill this child, so we can continue gracefully
	    # with further testing...
	    send_gdb "kill\n"
	    gdb_expect {
		-re ".*Kill the program being debugged.*y or n. $" {
		    send_gdb "y\n"
		    gdb_expect -re "$gdb_prompt $" {}
		}
	    }
	}
    }
}

# Test the ability to catch a fork, specify via a -do clause that
# the parent be followed, and continue.  Make the catchpoint temporary.

proc_with_prefix tcatch_fork_parent_follow {} {
    global gdb_prompt
    global srcfile
    global reading_in_symbols_re

    if { ![setup] } {
	return
    }

    set bp_after_fork [gdb_get_line_number "set breakpoint here"]

    gdb_test "catch fork" \
	"Catchpoint \[0-9\]* \\(fork\\)$reading_in_symbols_re" \
	"explicit parent follow, set tcatch fork"

# ??rehrauer: I don't yet know how to get the id of the tcatch
# via this script, so that I can add a -do list to it.  For now,
# do the follow stuff after the catch happens.

    gdb_test "continue" \
	"Catchpoint \[0-9\]* \\(forked process \[0-9\]*\\),.*" \
	"explicit parent follow, tcatch fork"

    gdb_test_no_output "set follow-fork parent"

    gdb_test "tbreak ${srcfile}:$bp_after_fork" \
	"Temporary breakpoint.*, line $bp_after_fork.*" \
	"set follow-fork parent, tbreak"

    gdb_test "continue" \
	"\\\[Detaching after fork from.* at .*$bp_after_fork.*" \
	"set follow-fork parent, hit tbreak"

    # The child has been detached; allow time for any output it might
    # generate to arrive, so that output doesn't get confused with
    # any expected debugger output from a subsequent testpoint.
    #
    exec sleep 1

    gdb_test "delete breakpoints" \
	"" \
	"set follow-fork parent, cleanup" \
	"Delete all breakpoints. \\(y or n\\) $" \
	"y"
}

# Test simple things about the "set follow-fork-mode" command.

proc_with_prefix test_set_follow_fork_command {} {
    clean_restart

    # Verify that help is available for "set follow-fork-mode".
    #
    gdb_test "help set follow-fork-mode" \
	"Set debugger response to a program call of fork or vfork..*
A fork or vfork creates a new process.  follow-fork-mode can be:.*
.*parent  - the original process is debugged after a fork.*
.*child   - the new process is debugged after a fork.*
The unfollowed process will continue to run..*
By default, the debugger will follow the parent process..*"

    # Verify that we can set follow-fork-mode, using an abbreviation
    # for both the flag and its value.
    #
    gdb_test_no_output "set follow-fork ch"

    gdb_test "show follow-fork" \
	"Debugger response to a program call of fork or vfork is \"child\".*" \
	"set follow-fork, using abbreviations"

    # Verify that we cannot set follow-fork-mode to nonsense.
    #
    gdb_test "set follow-fork chork" "Undefined item: \"chork\".*" \
	"set follow-fork to nonsense is prohibited"

    gdb_test_no_output "set follow-fork parent" "reset parent"
}

test_set_follow_fork_command

if { ![check_fork_catchpoints] } {
    untested "follow-fork not supported"
    return
}

# Test the basic follow-fork functionality using all combinations of
# values for follow-fork-mode and detach-on-fork, using either a
# breakpoint or single-step to execute past the fork.
#
# The first loop should be sufficient to test the defaults.  There
# is no need to test using the defaults in other permutations (e.g.
# "default" "on", "parent" "default", etc.).
foreach cmd {"next 2" "continue"} {
    test_follow_fork "default" "default" $cmd
}

# Now test all explicit permutations.
foreach who {"parent" "child"} {
    foreach detach {"on" "off"} {
	foreach cmd {"next 2" "continue"} {
	    test_follow_fork $who $detach $cmd
	}
    }
}

# Catchpoint tests.

catch_fork_child_follow
catch_fork_unpatch_child
tcatch_fork_parent_follow
Commit	Line	Data
3666a048	1	# Copyright 1997-2021 Free Software Foundation, Inc.
74cf1395 JM	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
e22f8b7c	5	# the Free Software Foundation; either version 3 of the License, or
74cf1395	6	# (at your option) any later version.
e22f8b7c	7	#
74cf1395 JM	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.
e22f8b7c	12	#
74cf1395	13	# You should have received a copy of the GNU General Public License
e85a822c	14	# along with this program. If not, see <http://www.gnu.org/licenses/>.
74cf1395	15
81f47ac2 AH	16	# Test relies on checking follow-fork output. Do not run if gdb debug is
	17	# enabled as it will be redirected to the log.
	18	if [gdb_debug_enabled] {
	19	untested "debug is enabled"
	20	return 0
	21	}
	22
289f9037 TT	23	standard_testfile
289f9037 TT	24
b45781dd	25	if {[build_executable "failed to prepare" $testfile $srcfile debug]} {
289f9037	26	return -1
74cf1395 JM	27	}
74cf1395 JM	28
b45781dd SM	29	# Restart GDB and run the inferior to main. Return 1 on success, 0 on failure.
	30
	31	proc setup {} {
	32	clean_restart $::testfile
	33
	34	if { ![runto_main] } {
	35	fail "could not run to main"
	36	return 0
	37	}
	38
	39	return 1
	40	}
	41
	42	# Check that fork catchpoints are supported, as an indicator for whether
	43	# fork-following is supported. Return 1 if they are, else 0.
	44
	45	proc_with_prefix check_fork_catchpoints {} {
e85a822c DJ	46	global gdb_prompt
e85a822c DJ	47
b45781dd SM	48	if { ![setup] } {
	49	return
	50	}
	51
e85a822c DJ	52	# Verify that the system supports "catch fork".
	53	gdb_test "catch fork" "Catchpoint \[0-9\]* \\(fork\\)" "insert first fork catchpoint"
	54	set has_fork_catchpoints 0
	55	gdb_test_multiple "continue" "continue to first fork catchpoint" {
77b06cd7	56	-re ".Your system does not support this type\r\nof catchpoint.$gdb_prompt $" {
e85a822c DJ	57	unsupported "continue to first fork catchpoint"
	58	}
	59	-re ".Catchpoint.$gdb_prompt $" {
	60	set has_fork_catchpoints 1
	61	pass "continue to first fork catchpoint"
	62	}
	63	}
	64
b45781dd	65	return $has_fork_catchpoints
e85a822c DJ	66	}
e85a822c DJ	67
a1aa2221 LM	68	# Test follow-fork to ensure that the correct process is followed, that
	69	# the followed process stops where it is expected to stop, that processes
	70	# are detached (or not) as expected, and that the inferior list has the
	71	# expected contents after following the fork. WHO is the argument to
	72	# the 'set follow-fork-mode' command, DETACH is the argument to the
	73	# 'set detach-on-fork' command, and CMD is the GDB command used to
	74	# execute the program past the fork. If the value of WHO or DETACH is
	75	# 'default', the corresponding GDB command is skipped for that test.
	76	# The value of CMD must be either 'next 2' or 'continue'.
b45781dd	77	proc_with_prefix test_follow_fork { who detach cmd } {
a76e022a	78	global gdb_prompt
a1aa2221 LM	79	global srcfile
a1aa2221 LM	80	global testfile
a76e022a	81
a1aa2221	82	with_test_prefix "follow $who, detach $detach, command \"$cmd\"" {
a76e022a	83
a1aa2221	84	# Start a new debugger session each time so defaults are legitimate.
b45781dd SM	85	if { ![setup] } {
b45781dd SM	86	return
a1aa2221	87	}
74cf1395	88
a1aa2221 LM	89	# The "Detaching..." and "Attaching..." messages may be hidden by
	90	# default.
	91	gdb_test_no_output "set verbose"
a76e022a	92
a1aa2221 LM	93	# Set follow-fork-mode if we aren't using the default.
	94	if {$who == "default"} {
	95	set who "parent"
	96	} else {
	97	gdb_test_no_output "set follow-fork $who"
	98	}
a76e022a	99
a1aa2221	100	gdb_test "show follow-fork" \
11af934b	101	"Debugger response to a program call of fork or vfork is \"$who\"."
a76e022a	102
a1aa2221 LM	103	# Set detach-on-fork mode if we aren't using the default.
	104	if {$detach == "default"} {
	105	set detach "on"
	106	} else {
	107	gdb_test_no_output "set detach-on-fork $detach"
	108	}
a76e022a	109
a1aa2221	110	gdb_test "show detach-on-fork" \
11af934b	111	"Whether gdb will detach.* fork is $detach."
a1aa2221 LM	112
	113	# Set a breakpoint after the fork if we aren't single-stepping
	114	# past the fork.
	115	if {$cmd == "continue"} {
	116	set bp_after_fork [gdb_get_line_number "set breakpoint here"]
	117	gdb_test "break ${srcfile}:$bp_after_fork" \
	118	"Breakpoint., line $bp_after_fork." \
	119	"set breakpoint after fork"
	120	}
74cf1395	121
a1aa2221 LM	122	# Set up the output we expect to see after we run.
	123	set expected_re ""
	124	if {$who == "child"} {
f67c0c91	125	set expected_re "\\\[Attaching after.* fork to.*"
6f259a23	126	if {$detach == "on"} {
f67c0c91	127	append expected_re "\\\[Detaching after fork from .*"
6f259a23 DB	128	}
6f259a23 DB	129	append expected_re "set breakpoint here.*"
a1aa2221	130	} elseif {$who == "parent" && $detach == "on"} {
f67c0c91	131	set expected_re "\\\[Detaching after fork from .set breakpoint here."
a1aa2221 LM	132	} else {
	133	set expected_re ".set breakpoint here."
	134	}
a76e022a	135
a1aa2221 LM	136	# Test running past and following the fork, using the parameters
	137	# set above.
	138	gdb_test $cmd $expected_re "$cmd past fork"
a76e022a	139
a1aa2221 LM	140	# Check that we have the inferiors arranged correctly after
	141	# following the fork.
	142	set resume_unfollowed 0
	143	if {$who == "parent" && $detach == "on"} {
a76e022a	144
a1aa2221	145	# Follow parent / detach child: the only inferior is the parent.
11af934b	146	gdb_test "info inferiors" "\\* 1 .* process.*"
a76e022a	147
a1aa2221 LM	148	} elseif {$who == "parent" && $detach == "off"} {
	149
	150	# Follow parent / keep child: two inferiors under debug, the
	151	# parent is the current inferior.
11af934b	152	gdb_test "info inferiors" "\\* 1 .process. 2 .process."
a1aa2221 LM	153
	154	gdb_test "inferior 2" "Switching to inferior 2 .*"
	155	set resume_unfollowed 1
	156
	157	} elseif {$who == "child" && $detach == "on"} {
	158
	159	# Follow child / detach parent: the child is under debug and is
	160	# the current inferior. The parent is listed but is not under
	161	# debug.
11af934b	162	gdb_test "info inferiors" " 1 .<null>.\\* 2 .process."
a1aa2221 LM	163
	164	} elseif {$who == "child" && $detach == "off"} {
	165
	166	# Follow child / keep parent: two inferiors under debug, the
	167	# child is the current inferior.
11af934b	168	gdb_test "info inferiors" " 1 .process.\\* 2 .process."
a1aa2221 LM	169
	170	gdb_test "inferior 1" "Switching to inferior 1 .*"
	171	set resume_unfollowed 1
	172	}
	173
	174	if {$resume_unfollowed == 1} {
	175	if {$cmd == "next 2"} {
	176
	177	gdb_continue_to_end "continue unfollowed inferior to end"
	178
	179	} elseif {$cmd == "continue"} {
	180
	181	gdb_continue_to_breakpoint \
	182	"continue unfollowed inferior to bp" \
	183	".* set breakpoint here.*"
	184	}
	185	}
	186	}
74cf1395 JM	187	}
74cf1395 JM	188
7462c383 TV	189	set reading_in_symbols_re {(?:\r\nReading in symbols for [^\r\n]*)?}
7462c383 TV	190
b45781dd SM	191	# Test the ability to catch a fork, specify that the child be
	192	# followed, and continue. Make the catchpoint permanent.
	193
	194	proc_with_prefix catch_fork_child_follow {} {
a76e022a MS	195	global gdb_prompt
a76e022a MS	196	global srcfile
7462c383	197	global reading_in_symbols_re
a76e022a	198
b45781dd SM	199	if { ![setup] } {
	200	return
	201	}
	202
a76e022a MS	203	set bp_after_fork [gdb_get_line_number "set breakpoint here"]
a76e022a MS	204
7462c383 TV	205	gdb_test "catch fork" \
7462c383 TV	206	"Catchpoint \[0-9\]* \\(fork\\)$reading_in_symbols_re" \
a76e022a MS	207	"explicit child follow, set catch fork"
	208
	209	# Verify that the catchpoint is mentioned in an "info breakpoints",
	210	# and further that the catchpoint mentions no process id.
59767d3c SM	211	gdb_test "info breakpoints" \
	212	".catchpoint.keep y.*fork\[\r\n\]+" \
	213	"info breakpoints before fork"
a76e022a MS	214
a76e022a MS	215	gdb_test "continue" \
2c04da0d	216	"Catchpoint \[0-9\]* \\(forked process \[0-9\]\\),." \
a76e022a MS	217	"explicit child follow, catch fork"
	218
	219	# Verify that the catchpoint is mentioned in an "info breakpoints",
	220	# and further that the catchpoint managed to capture a process id.
59767d3c SM	221	gdb_test "info breakpoints" \
	222	".catchpoint.keep y.fork, process." \
	223	"info breakpoints after fork"
a76e022a MS	224
	225	gdb_test_no_output "set follow-fork child"
	226
	227	gdb_test "tbreak ${srcfile}:$bp_after_fork" \
	228	"Temporary breakpoint., line $bp_after_fork." \
	229	"set follow-fork child, tbreak"
	230
f67c0c91	231	set expected_re "\\\[Attaching after.* fork to.*\\\[Detaching after fork from"
6f259a23 DB	232	append expected_re ".* at .$bp_after_fork."
6f259a23 DB	233	gdb_test "continue" $expected_re "set follow-fork child, hit tbreak"
a76e022a MS	234
	235	# The parent has been detached; allow time for any output it might
	236	# generate to arrive, so that output doesn't get confused with
	237	# any expected debugger output from a subsequent testpoint.
	238	#
	239	exec sleep 1
	240
	241	gdb_test "delete breakpoints" \
	242	"" \
	243	"set follow-fork child, cleanup" \
e9101ff5	244	"Delete all breakpoints. \\(y or n\\) $" \
a76e022a	245	"y"
74cf1395 JM	246	}
74cf1395 JM	247
b45781dd SM	248	# Test that parent breakpoints are successfully detached from the
	249	# child at fork time, even if the user removes them from the
	250	# breakpoints list after stopping at a fork catchpoint.
	251
	252	proc_with_prefix catch_fork_unpatch_child {} {
a76e022a MS	253	global gdb_prompt
	254	global srcfile
	255
b45781dd SM	256	if { ![setup] } {
	257	return
	258	}
	259
a76e022a MS	260	set bp_exit [gdb_get_line_number "at exit"]
	261
	262	gdb_test "break callee" "file .$srcfile, line ." \
	263	"unpatch child, break at callee"
	264	gdb_test "catch fork" "Catchpoint \[0-9\]* \\(fork\\)" \
	265	"unpatch child, set catch fork"
	266
	267	gdb_test "continue" \
2c04da0d	268	"Catchpoint \[0-9\]* \\(forked process \[0-9\]\\),." \
a76e022a MS	269	"unpatch child, catch fork"
	270
	271	# Delete all breakpoints and catchpoints.
	272	delete_breakpoints
	273
	274	# Force $srcfile as the current GDB source can be in glibc sourcetree.
	275	gdb_test "break $srcfile:$bp_exit" \
	276	"Breakpoint .file .$srcfile, line .*" \
	277	"unpatch child, breakpoint at exit call"
	278
27d3a1a2 MS	279	gdb_test_no_output "set follow-fork child" \
27d3a1a2 MS	280	"unpatch child, set follow-fork child"
a76e022a MS	281
	282	set test "unpatch child, unpatched parent breakpoints from child"
	283	gdb_test_multiple "continue" $test {
	284	-re "at exit.*$gdb_prompt $" {
	285	pass "$test"
	286	}
	287	-re "SIGTRAP.*$gdb_prompt $" {
	288	fail "$test"
	289
	290	# Explicitly kill this child, so we can continue gracefully
	291	# with further testing...
	292	send_gdb "kill\n"
	293	gdb_expect {
	294	-re ".Kill the program being debugged.y or n. $" {
	295	send_gdb "y\n"
	296	gdb_expect -re "$gdb_prompt $" {}
	297	}
	298	}
	299	}
	300	}
b242c3c2 PA	301	}
b242c3c2 PA	302
b45781dd SM	303	# Test the ability to catch a fork, specify via a -do clause that
	304	# the parent be followed, and continue. Make the catchpoint temporary.
	305
	306	proc_with_prefix tcatch_fork_parent_follow {} {
a76e022a MS	307	global gdb_prompt
a76e022a MS	308	global srcfile
7462c383	309	global reading_in_symbols_re
a76e022a	310
b45781dd SM	311	if { ![setup] } {
	312	return
	313	}
	314
a76e022a MS	315	set bp_after_fork [gdb_get_line_number "set breakpoint here"]
a76e022a MS	316
7462c383 TV	317	gdb_test "catch fork" \
7462c383 TV	318	"Catchpoint \[0-9\]* \\(fork\\)$reading_in_symbols_re" \
a76e022a MS	319	"explicit parent follow, set tcatch fork"
a76e022a MS	320
74cf1395 JM	321	# ??rehrauer: I don't yet know how to get the id of the tcatch
	322	# via this script, so that I can add a -do list to it. For now,
	323	# do the follow stuff after the catch happens.
	324
2c04da0d UW	325	gdb_test "continue" \
2c04da0d UW	326	"Catchpoint \[0-9\]* \\(forked process \[0-9\]\\),." \
a76e022a MS	327	"explicit parent follow, tcatch fork"
	328
	329	gdb_test_no_output "set follow-fork parent"
	330
	331	gdb_test "tbreak ${srcfile}:$bp_after_fork" \
	332	"Temporary breakpoint., line $bp_after_fork." \
	333	"set follow-fork parent, tbreak"
	334
	335	gdb_test "continue" \
f67c0c91	336	"\\\[Detaching after fork from.* at .$bp_after_fork." \
a76e022a MS	337	"set follow-fork parent, hit tbreak"
	338
	339	# The child has been detached; allow time for any output it might
	340	# generate to arrive, so that output doesn't get confused with
	341	# any expected debugger output from a subsequent testpoint.
	342	#
	343	exec sleep 1
	344
	345	gdb_test "delete breakpoints" \
	346	"" \
	347	"set follow-fork parent, cleanup" \
e9101ff5	348	"Delete all breakpoints. \\(y or n\\) $" \
a76e022a	349	"y"
74cf1395 JM	350	}
74cf1395 JM	351
b45781dd SM	352	# Test simple things about the "set follow-fork-mode" command.
	353
	354	proc_with_prefix test_set_follow_fork_command {} {
	355	clean_restart
74cf1395	356
a76e022a MS	357	# Verify that help is available for "set follow-fork-mode".
	358	#
	359	gdb_test "help set follow-fork-mode" \
	360	"Set debugger response to a program call of fork or vfork..*
74cf1395 JM	361	A fork or vfork creates a new process. follow-fork-mode can be:.*
	362	.parent - the original process is debugged after a fork.
	363	.child - the new process is debugged after a fork.
ef04f396	364	The unfollowed process will continue to run..*
11af934b	365	By default, the debugger will follow the parent process..*"
a76e022a MS	366
	367	# Verify that we can set follow-fork-mode, using an abbreviation
	368	# for both the flag and its value.
	369	#
	370	gdb_test_no_output "set follow-fork ch"
	371
	372	gdb_test "show follow-fork" \
	373	"Debugger response to a program call of fork or vfork is \"child\".*" \
	374	"set follow-fork, using abbreviations"
	375
	376	# Verify that we cannot set follow-fork-mode to nonsense.
	377	#
	378	gdb_test "set follow-fork chork" "Undefined item: \"chork\".*" \
	379	"set follow-fork to nonsense is prohibited"
	380
	381	gdb_test_no_output "set follow-fork parent" "reset parent"
b45781dd	382	}
a76e022a	383
b45781dd	384	test_set_follow_fork_command
a76e022a	385
b45781dd SM	386	if { ![check_fork_catchpoints] } {
	387	untested "follow-fork not supported"
	388	return
	389	}
a76e022a	390
b45781dd SM	391	# Test the basic follow-fork functionality using all combinations of
	392	# values for follow-fork-mode and detach-on-fork, using either a
	393	# breakpoint or single-step to execute past the fork.
	394	#
	395	# The first loop should be sufficient to test the defaults. There
	396	# is no need to test using the defaults in other permutations (e.g.
	397	# "default" "on", "parent" "default", etc.).
	398	foreach cmd {"next 2" "continue"} {
	399	test_follow_fork "default" "default" $cmd
	400	}
	401
	402	# Now test all explicit permutations.
	403	foreach who {"parent" "child"} {
	404	foreach detach {"on" "off"} {
	405	foreach cmd {"next 2" "continue"} {
	406	test_follow_fork $who $detach $cmd
a1aa2221 LM	407	}
a1aa2221 LM	408	}
74cf1395 JM	409	}
74cf1395 JM	410
b45781dd	411	# Catchpoint tests.
74cf1395	412
b45781dd SM	413	catch_fork_child_follow
	414	catch_fork_unpatch_child
	415	tcatch_fork_parent_follow