# Copyright 2011-2024 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 fork handling of an inferior that has JIT-ed objfiles.

require allow_shlib_tests

load_lib jit-elf-helpers.exp

# The main code that loads and registers JIT objects.
set main_basename "jit-elf-fork-main"
set main_srcfile ${srcdir}/${subdir}/${main_basename}.c
set main_binfile [standard_output_file ${main_basename}]

# The shared library that gets loaded as JIT objects.
set jit_solib_basename jit-elf-fork-solib
set jit_solib_srcfile ${srcdir}/${subdir}/${jit_solib_basename}.c

# Compile a shared library to use as JIT objects.
set jit_solibs_target [compile_and_download_n_jit_so \
		       $jit_solib_basename $jit_solib_srcfile 1]
if { $jit_solibs_target == -1 } {
    return
}

# Compile the main code (which loads the JIT objects).
if { [compile_jit_main ${main_srcfile} ${main_binfile} {}] != 0 } {
    return
}

# Set up for the tests.
#
# detach-on-fork and follow-fork-mode are the values to use for the GDB
# parameters of the same names.
#
# Upon return, execution is stopped at the breakpoint just after fork.  Which
# inferiors exist and which inferior is the current one depends on the
# parameter.
#
# The only breakpoint left is one just before the return statement in main, so
# that the callers can continue execution until there.

proc do_setup { detach-on-fork follow-fork-mode } {
	clean_restart ${::main_binfile}

	gdb_test_no_output "set detach-on-fork ${detach-on-fork}"
	gdb_test_no_output "set follow-fork-mode ${follow-fork-mode}"

	if { ![runto_main] } {
		return -1
	}

	# Poke desired values directly into inferior.
	gdb_test_no_output "set var argc=2" "forging argc"
	gdb_test_no_output "set var argv=fake_argv" "forging argv"
	set jit_solib_target [lindex $::jit_solibs_target 0]
	gdb_test_no_output "set var argv\[1]=\"${jit_solib_target}\"" {forging argv[1]}

	# Put a breakpoint before the fork, continue there.
	gdb_breakpoint [gdb_get_line_number "break before fork" $::main_srcfile]
	gdb_continue_to_breakpoint "continue to before fork" ".*break before fork.*"

	# We should have one JIT object loaded.
	gdb_test "maint info jit" \
	    [multi_line \
		 "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
		 "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
	    "jit-ed objfiles before fork"

	# Put a breakpoint just after the fork, continue there.
	gdb_breakpoint [gdb_get_line_number "break after fork" $::main_srcfile]
	gdb_continue_to_breakpoint "continue to after fork" ".*break after fork.*"

	# We should still have one JIT object loaded in whatever inferior we are
	# currently stopped in, regardless of the mode.
	gdb_test "maint info jit" \
	    [multi_line \
		 "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
		 "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
	    "jit-ed objfiles after fork"

	# Delete our breakpoints.
	delete_breakpoints

	# Put a breakpoint before return, for the convenience of our callers.
	gdb_breakpoint [gdb_get_line_number "break before return" $::main_srcfile]
}

proc_with_prefix test_detach_on_fork_off_follow_fork_mode_parent { } {
	if { [do_setup off parent] == -1 } {
		return -1
	}

	# We are stopped in the parent.
	gdb_test "inferior" "Current inferior is 1.*" "current inferior is parent"

	# Switch to the child, verify there is a JIT-ed objfile.
	gdb_test "inferior 2" "Switching to inferior 2.*"
	gdb_test "maint info jit" \
	    [multi_line \
		 "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
		 "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
	    "jit-ed objfile in child"

	# Continue child past JIT unload, verify there are no more JIT-ed objfiles.
	gdb_continue_to_breakpoint "continue to before return - child" ".*break before return.*"
	gdb_test_no_output "maint info jit" "no more jit-ed objfiles in child"

	# Go back to parent, the JIT-ed objfile should still be there.
	gdb_test "inferior 1" "Switching to inferior 1.*"
	gdb_test "maint info jit"  \
	    [multi_line \
		 "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
		 "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
	    "jit-ed objfile in parent"

	# Continue parent past JIT unload, verify there are no more JIT-ed objfiles.
	gdb_continue_to_breakpoint "continue to before return - parent" ".*break before return.*"
	gdb_test_no_output "maint info jit" "no more jit-ed objfiles in parent"
}

proc_with_prefix test_detach_on_fork_off_follow_fork_mode_child { } {
	if { [do_setup off child] == -1 } {
		return -1
	}

	# We are stopped in the child.  This is the exact same thing as
	# test_detach_on_fork_off_follow_fork_mode_parent, except that we are
	# stopped in the child.
	gdb_test "inferior" "Current inferior is 2.*" "current inferior is child"

	# Switch to the parent, verify there is a JIT-ed objfile.
	gdb_test "inferior 1" "Switching to inferior 1.*"
	gdb_test "maint info jit"  \
	    [multi_line \
		 "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
		 "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
	    "jit-ed objfile in parent"

	# Continue parent past JIT unload, verify there are no more JIT-ed objfiles.
	gdb_continue_to_breakpoint "continue to before return - parent" ".*break before return.*"
	gdb_test_no_output "maint info jit" "no more jit-ed objfiles in parent"

	# Go back to child, the JIT-ed objfile should still be there.
	gdb_test "inferior 2" "Switching to inferior 2.*"
	gdb_test "maint info jit"  \
	    [multi_line \
		 "jit_code_entry address\\s+symfile address\\s+symfile size\\s*" \
		 "${::hex}\\s+${::hex}\\s+${::decimal}\\s*"] \
	    "jit-ed objfile in child"

	# Continue child past JIT unload, verify there are no more JIT-ed objfiles.
	gdb_continue_to_breakpoint "continue to before return - child" ".*break before return.*"
	gdb_test_no_output "maint info jit" "no more jit-ed objfiles in child"
}

proc_with_prefix test_detach_on_fork_on_follow_fork_mode_parent { } {
	if { [do_setup on parent] == -1 } {
		return -1
	}

	# We are stopped in the parent, child is detached.
	gdb_test "inferior" "Current inferior is 1.*" "current inferior is parent"
	gdb_test "inferior 2" "Inferior ID 2 not known." "no inferior 2"

	# Continue past JIT unload, verify there are no more JIT-ed objfiles.
	gdb_continue_to_breakpoint "continue to before return" ".*break before return.*"
	gdb_test_no_output "maint info jit" "no more jit-ed objfiles"
}

proc_with_prefix test_detach_on_fork_on_follow_fork_mode_child { } {
	if { [do_setup on child] == -1 } {
		return -1
	}

	# We are stopped in the child, parent is detached.
	gdb_test "inferior" "Current inferior is 2.*" "current inferior is child"
	gdb_test "inferior 1" "Switching to inferior 1 \\\[<null>\\\].*"
	gdb_test "inferior 2" "Switching to inferior 2.*"

	# Continue past JIT unload, verify there are no more JIT-ed objfiles.
	gdb_continue_to_breakpoint "continue to before return" ".*break before return.*"
	gdb_test_no_output "maint info jit" "no more jit-ed objfiles"
}

test_detach_on_fork_off_follow_fork_mode_parent
test_detach_on_fork_off_follow_fork_mode_child
test_detach_on_fork_on_follow_fork_mode_parent
test_detach_on_fork_on_follow_fork_mode_child