# Copyright (C) 2021-2025 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 that we can access memory while all the threads of the inferior
# are running, and even if:
#
# - the leader thread exits
# - the selected thread exits
#
# This test constantly spawns short lived threads to make sure that on
# systems with debug APIs that require passing down a specific thread
# to work with (e.g., GNU/Linux ptrace and /proc filesystem), GDB
# copes with accessing memory just while the thread it is accessing
# memory through exits.
#
# The test spawns two processes and alternates memory accesses between
# them to force flushing per-process caches.  When the testcase was
# originally written, the Linux backend would access inferior memory
# via /proc/PID/mem, and kept one such file open, as a cache.
# Alternating inferiors would force re-opening such file for a
# different process, which would fail if GDB tried to open the file
# for a thread that exited.  The test thus ensured those reopen/fail
# code paths were exercised.  Nowadays, GDB keeps one /proc/PID/mem
# file open per inferior.

standard_testfile

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

# The test proper.  NON_STOP indicates whether we're testing in
# non-stop, or all-stop mode.

proc test { non_stop } {
    global binfile
    global gdb_prompt
    global GDBFLAGS

    save_vars { GDBFLAGS } {
      append GDBFLAGS " -ex \"set non-stop $non_stop\""
      clean_restart ${binfile}
    }

    if ![runto setup_done] {
	return -1
    }

    # If debugging with target remote, check whether the all-stop variant
    # of the RSP is being used.  If so, we can't run the background tests.
    if {!$non_stop
	&& [target_info exists gdb_protocol]
	&& ([target_info gdb_protocol] == "remote"
	    || [target_info gdb_protocol] == "extended-remote")} {

	if {![is_target_non_stop]} {
	    unsupported "can't issue commands while target is running"
	    return 0
	}
    }

    delete_breakpoints

    # Start the second inferior.
    if {[allow_multi_inferior_tests]} {
	with_test_prefix "second inferior" {
	    # With stub targets that do reload on run, if we let the
	    # new inferior share inferior 1's connection, runto would
	    # fail because GDB is already connected to something, like
	    # e.g. with --target_board=native-gdbserver:
	    #
	    #  (gdb) kill
	    #  ...
	    #  (gdb) target remote localhost:2348
	    #  Already connected to a remote target.  Disconnect? (y or n)
	    #
	    # Instead, start the inferior with no connection, and let
	    # gdb_load/runto spawn a new remote connection/gdbserver.
	    #
	    # OTOH, with extended-remote, we must let the new inferior
	    # reuse the current connection, so that runto below can
	    # issue the "run" command, and have the inferior run on
	    # the remote target.  If we forced no connection, then
	    # "run" would either fail if "set
	    # auto-connect-native-target" is on, like the
	    # native-extended-gdbserver board enforces, or it would
	    # run the inferior on the native target, which isn't what
	    # is being tested.
	    #
	    # Since it's reload_on_run targets that need special care,
	    # we default to reusing the connection on most targets.
	    if [target_info exists gdb,do_reload_on_run] {
		gdb_test "add-inferior -no-connection" "New inferior 2.*"
	    } else {
		gdb_test "add-inferior" "New inferior 2.*"
	    }
	    gdb_test "inferior 2" "Switching to inferior 2 .*"

	    gdb_load $binfile

	    if ![runto setup_done] {
		return -1
	    }
	}
    }

    delete_breakpoints

    # These put too much noise in the logs.
    gdb_test_no_output "set print thread-events off"

    # Continue all threads of both processes.
    gdb_test_no_output "set schedule-multiple on"
    if {$non_stop == "off"} {
	set cmd "continue &"
    } else {
	set cmd "continue -a &"
    }
    gdb_test_multiple $cmd "continuing" {
	-re "Continuing\.\r\n$gdb_prompt " {
	    pass $gdb_test_name
	}
    }

    # Like gdb_test, but:
    # - don't issue a pass on success.
    # - on failure, clear the ok variable in the calling context, and
    #   break it.
    proc my_gdb_test {cmd pattern message} {
	upvar inf inf
	upvar iter iter
	if {[gdb_test -nopass \
		 $cmd $pattern "access mem ($message, inf=$inf, iter=$iter)"] \
		!= 0} {
	    uplevel 1 {set ok 0}
	    return -code break
	}
    }

    # Hammer away for 5 seconds, alternating between inferiors.
    set ::done 0
    after 5000 { set ::done 1 }

    set inf 1
    set ok 1
    set iter 0
    while {!$::done && $ok} {
	incr iter
	verbose -log "xxxxx: iteration $iter"
	gdb_test -nopass "info threads"

	if {[allow_multi_inferior_tests]} {
	    if {$inf == 1} {
		set inf 2
	    } else {
		set inf 1
	    }

	    my_gdb_test "inferior $inf" ".*" "inferior $inf"
	}

	my_gdb_test "print global_var = 555" " = 555" \
	    "write to global_var"
	my_gdb_test "print global_var" " = 555" \
	    "print global_var after writing"
	my_gdb_test "print global_var = 333" " = 333" \
	    "write to global_var again"
	my_gdb_test "print global_var" " = 333" \
	    "print global_var after writing again"
    }

   if {$ok} {
       pass "access mem"
   }
}

foreach non_stop { "off" "on" } {
    set stop_mode [expr ($non_stop=="off")?"all-stop":"non-stop"]
    with_test_prefix "$stop_mode" {
	test $non_stop
    }
}