gdb/testsuite/gdb.base/foll-fork.exp

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