# Copyright (C) 2021-2023 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_main] {
	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")} {

	gdb_test_multiple "maint show target-non-stop" "" {
	    -wrap -re "(is|currently) on.*" {
	    }
	    -wrap -re "(is|currently) off.*" {
		unsupported "can't issue commands while target is running"
		return 0
	    }
	}
    }

    delete_breakpoints

    # Start the second inferior.
    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_main 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_main spawn a new remote connection/gdbserver.
	#
	# OTOH, with extended-remote, we must let the new inferior
	# reuse the current connection, so that runto_main 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_main] {
	    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 {$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
    }
}