gdb/testsuite/gdb.base/jit-elf-fork.exp

   1 # Copyright 2011-2023 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 fork handling of an inferior that has JIT-ed objfiles.
  17
  18 if {[skip_shlib_tests]} {
  19     untested "skipping shared library tests"
  20     return -1
  21 }
  22
  23 load_lib jit-elf-helpers.exp
  24
  25 # The main code that loads and registers JIT objects.
  26 set main_basename "jit-elf-fork-main"
  27 set main_srcfile ${srcdir}/${subdir}/${main_basename}.c
  28 set main_binfile [standard_output_file ${main_basename}]
  29
  30 # The shared library that gets loaded as JIT objects.
  31 set jit_solib_basename jit-elf-fork-solib
  32 set jit_solib_srcfile ${srcdir}/${subdir}/${jit_solib_basename}.c
  33
  34 # Compile a shared library to use as JIT objects.
  35 set jit_solibs_target [compile_and_download_n_jit_so \
  36                        $jit_solib_basename $jit_solib_srcfile 1]
  37 if { $jit_solibs_target == -1 } {
  38     return
  39 }
  40
  41 # Compile the main code (which loads the JIT objects).
  42 if { [compile_jit_main ${main_srcfile} ${main_binfile} {}] != 0 } {
  43     return
  44 }
  45
  46 # Set up for the tests.
  47 #
  48 # detach-on-fork and follow-fork-mode are the values to use for the GDB
  49 # parameters of the same names.
  50 #
  51 # Upon return, execution is stopped at the breakpoint just after fork.  Which
  52 # inferiors exist and which inferior is the current one depends on the
  53 # parameter.
  54 #
  55 # The only breakpoint left is one just before the return statement in main, so
  56 # that the callers can continue execution until there.
  57
  58 proc do_setup { detach-on-fork follow-fork-mode } {
  59         clean_restart ${::main_binfile}
  60
  61         gdb_test_no_output "set detach-on-fork ${detach-on-fork}"
  62         gdb_test_no_output "set follow-fork-mode ${follow-fork-mode}"
  63
  64         if { ![runto_main] } {
  65                 return -1
  66         }
  67
  68         # Poke desired values directly into inferior.
  69         gdb_test_no_output "set var argc=2" "forging argc"
  70         gdb_test_no_output "set var argv=fake_argv" "forging argv"
  71         set jit_solib_target [lindex $::jit_solibs_target 0]
  72         gdb_test_no_output "set var argv\[1]=\"${jit_solib_target}\"" {forging argv[1]}
  73
  74         # Put a breakpoint before the fork, continue there.
  75         gdb_breakpoint [gdb_get_line_number "break before fork" $::main_srcfile]
  76         gdb_continue_to_breakpoint "continue to before fork" ".*break before fork.*"
  77
  78         # We should have one JIT object loaded.
  79         gdb_test "maint info jit" \
  80             [multi_line \
  81                  "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
  82                  "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
  83             "jit-ed objfiles before fork"
  84
  85         # Put a breakpoint just after the fork, continue there.
  86         gdb_breakpoint [gdb_get_line_number "break after fork" $::main_srcfile]
  87         gdb_continue_to_breakpoint "continue to after fork" ".*break after fork.*"
  88
  89         # We should still have one JIT object loaded in whatever inferior we are
  90         # currently stopped in, regardless of the mode.
  91         gdb_test "maint info jit" \
  92             [multi_line \
  93                  "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
  94                  "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
  95             "jit-ed objfiles after fork"
  96
  97         # Delete our breakpoints.
  98         delete_breakpoints
  99
 100         # Put a breakpoint before return, for the convenience of our callers.
 101         gdb_breakpoint [gdb_get_line_number "break before return" $::main_srcfile]
 102 }
 103
 104 proc_with_prefix test_detach_on_fork_off_follow_fork_mode_parent { } {
 105         if { [do_setup off parent] == -1 } {
 106                 return -1
 107         }
 108
 109         # We are stopped in the parent.
 110         gdb_test "inferior" "Current inferior is 1.*" "current inferior is parent"
 111
 112         # Switch to the child, verify there is a JIT-ed objfile.
 113         gdb_test "inferior 2" "Switching to inferior 2.*"
 114         gdb_test "maint info jit" \
 115             [multi_line \
 116                  "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
 117                  "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
 118             "jit-ed objfile in child"
 119
 120         # Continue child past JIT unload, verify there are no more JIT-ed objfiles.
 121         gdb_continue_to_breakpoint "continue to before return - child" ".*break before return.*"
 122         gdb_test_no_output "maint info jit" "no more jit-ed objfiles in child"
 123
 124         # Go back to parent, the JIT-ed objfile should still be there.
 125         gdb_test "inferior 1" "Switching to inferior 1.*"
 126         gdb_test "maint info jit"  \
 127             [multi_line \
 128                  "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
 129                  "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
 130             "jit-ed objfile in parent"
 131
 132         # Continue parent past JIT unload, verify there are no more JIT-ed objfiles.
 133         gdb_continue_to_breakpoint "continue to before return - parent" ".*break before return.*"
 134         gdb_test_no_output "maint info jit" "no more jit-ed objfiles in parent"
 135 }
 136
 137 proc_with_prefix test_detach_on_fork_off_follow_fork_mode_child { } {
 138         if { [do_setup off child] == -1 } {
 139                 return -1
 140         }
 141
 142         # We are stopped in the child.  This is the exact same thing as
 143         # test_detach_on_fork_off_follow_fork_mode_parent, except that we are
 144         # stopped in the child.
 145         gdb_test "inferior" "Current inferior is 2.*" "current inferior is child"
 146
 147         # Switch to the parent, verify there is a JIT-ed objfile.
 148         gdb_test "inferior 1" "Switching to inferior 1.*"
 149         gdb_test "maint info jit"  \
 150             [multi_line \
 151                  "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
 152                  "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
 153             "jit-ed objfile in parent"
 154
 155         # Continue parent past JIT unload, verify there are no more JIT-ed objfiles.
 156         gdb_continue_to_breakpoint "continue to before return - parent" ".*break before return.*"
 157         gdb_test_no_output "maint info jit" "no more jit-ed objfiles in parent"
 158
 159         # Go back to child, the JIT-ed objfile should still be there.
 160         gdb_test "inferior 2" "Switching to inferior 2.*"
 161         gdb_test "maint info jit"  \
 162             [multi_line \
 163                  "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
 164                  "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
 165             "jit-ed objfile in child"
 166
 167         # Continue child past JIT unload, verify there are no more JIT-ed objfiles.
 168         gdb_continue_to_breakpoint "continue to before return - child" ".*break before return.*"
 169         gdb_test_no_output "maint info jit" "no more jit-ed objfiles in child"
 170 }
 171
 172 proc_with_prefix test_detach_on_fork_on_follow_fork_mode_parent { } {
 173         if { [do_setup on parent] == -1 } {
 174                 return -1
 175         }
 176
 177         # We are stopped in the parent, child is detached.
 178         gdb_test "inferior" "Current inferior is 1.*" "current inferior is parent"
 179         gdb_test "inferior 2" "Inferior ID 2 not known." "no inferior 2"
 180
 181         # Continue past JIT unload, verify there are no more JIT-ed objfiles.
 182         gdb_continue_to_breakpoint "continue to before return" ".*break before return.*"
 183         gdb_test_no_output "maint info jit" "no more jit-ed objfiles"
 184 }
 185
 186 proc_with_prefix test_detach_on_fork_on_follow_fork_mode_child { } {
 187         if { [do_setup on child] == -1 } {
 188                 return -1
 189         }
 190
 191         # We are stopped in the child, parent is detached.
 192         gdb_test "inferior" "Current inferior is 2.*" "current inferior is child"
 193         gdb_test "inferior 1" "Switching to inferior 1 \\\[<null>\\\].*"
 194         gdb_test "inferior 2" "Switching to inferior 2.*"
 195
 196         # Continue past JIT unload, verify there are no more JIT-ed objfiles.
 197         gdb_continue_to_breakpoint "continue to before return" ".*break before return.*"
 198         gdb_test_no_output "maint info jit" "no more jit-ed objfiles"
 199 }
 200
 201 test_detach_on_fork_off_follow_fork_mode_parent
 202 test_detach_on_fork_off_follow_fork_mode_child
 203 test_detach_on_fork_on_follow_fork_mode_parent
 204 test_detach_on_fork_on_follow_fork_mode_child