X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Ftestsuite%2Flib%2Fgdb.exp;h=50db45d1b1456bbc146a51e49e77e99734ecede0;hb=3d63690a0316d92cf248542ee12a3fc8b30152ea;hp=b9b3a45a79de7c5d95da57a762b03d91acdd64a9;hpb=bc6c7af4a2f23c48a38139fc7e0ed2ac7b12bb69;p=deliverable%2Fbinutils-gdb.git

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index b9b3a45a79..50db45d1b1 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1,4 +1,4 @@
-# Copyright 1992-2016 Free Software Foundation, Inc.
+# Copyright 1992-2019 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
@@ -28,6 +28,7 @@ if {$tool == ""} {
 load_lib libgloss.exp
 load_lib cache.exp
 load_lib gdb-utils.exp
+load_lib memory.exp
 
 global GDB
 
@@ -81,7 +82,8 @@ if ![info exists gdb_prompt] then {
 }
 
 # A regexp that matches the pagination prompt.
-set pagination_prompt [string_to_regexp "---Type <return> to continue, or q <return> to quit---"]
+set pagination_prompt \
+    "--Type <RET> for more, q to quit, c to continue without paging--"
 
 # The variable fullname_syntax_POSIX is a regexp which matches a POSIX 
 # absolute path ie. /foo/ 
@@ -165,11 +167,11 @@ proc gdb_unload {} {
 	-re "No executable file now\[^\r\n\]*\[\r\n\]" { exp_continue }
 	-re "No symbol file now\[^\r\n\]*\[\r\n\]" { exp_continue }
 	-re "A program is being debugged already.*Are you sure you want to change the file.*y or n. $" {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    exp_continue
 	}
 	-re "Discard symbol table from .*y or n.*$" {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    exp_continue
 	}
 	-re "$gdb_prompt $" {}
@@ -199,7 +201,7 @@ proc delete_breakpoints {} {
     set deleted 0
     gdb_test_multiple "delete breakpoints" "$msg" {
 	-re "Delete all breakpoints.*y or n.*$" {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    exp_continue
 	}
 	-re "$gdb_prompt $" {
@@ -225,6 +227,19 @@ proc delete_breakpoints {} {
     }
 }
 
+# Returns true iff the target supports using the "run" command.
+
+proc target_can_use_run_cmd {} {
+    if [target_info exists use_gdb_stub] {
+	# In this case, when we connect, the inferior is already
+	# running.
+	return 0
+    }
+
+    # Assume yes.
+    return 1
+}
+
 # Generic run command.
 #
 # The second pattern below matches up to the first newline *only*.
@@ -292,7 +307,7 @@ proc gdb_run_cmd {args} {
 		    set start_attempt 0
 		}
 		-re "Line.* Jump anyway.*y or n. $" {
-		    send_gdb "y\n"
+		    send_gdb "y\n" answer
 		}
 		-re "The program is not being run.*$gdb_prompt $" {
 		    if { [gdb_reload] != 0 } {
@@ -320,7 +335,7 @@ proc gdb_run_cmd {args} {
 # may test for additional start-up messages.
    gdb_expect 60 {
 	-re "The program .* has been started already.*y or n. $" {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    exp_continue
 	}
 	-notransfer -re "Starting program: \[^\r\n\]*" {}
@@ -359,7 +374,7 @@ proc gdb_start_cmd {args} {
     # may test for additional start-up messages.
     gdb_expect 60 {
 	-re "The program .* has been started already.*y or n. $" {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    exp_continue
 	}
 	-notransfer -re "Starting program: \[^\r\n\]*" {
@@ -369,9 +384,46 @@ proc gdb_start_cmd {args} {
     return -1
 }
 
+# Generic starti command.  Return 0 if we could start the program, -1
+# if we could not.
+#
+# N.B. This function does not wait for gdb to return to the prompt,
+# that is the caller's responsibility.
+
+proc gdb_starti_cmd {args} {
+    global gdb_prompt use_gdb_stub
+
+    foreach command [gdb_init_commands] {
+	send_gdb "$command\n"
+	gdb_expect 30 {
+	    -re "$gdb_prompt $" { }
+	    default {
+		perror "gdb_init_command for target failed"
+		return -1
+	    }
+	}
+    }
+
+    if $use_gdb_stub {
+	return -1
+    }
+
+    send_gdb "starti $args\n"
+    gdb_expect 60 {
+	-re "The program .* has been started already.*y or n. $" {
+	    send_gdb "y\n" answer
+	    exp_continue
+	}
+	-re "Starting program: \[^\r\n\]*" {
+	    return 0
+	}
+    }
+    return -1
+}
+
 # Set a breakpoint at FUNCTION.  If there is an additional argument it is
 # a list of options; the supported options are allow-pending, temporary,
-# message, no-message, and passfail.
+# message, no-message, passfail and qualified.
 # The result is 1 for success, 0 for failure.
 #
 # Note: The handling of message vs no-message is messed up, but it's based
@@ -396,6 +448,10 @@ proc gdb_breakpoint { function args } {
 	set break_message "Temporary breakpoint"
     }
 
+    if {[lsearch -exact $args qualified] != -1} {
+	append break_command " -qualified"
+    }
+
     set print_pass 0
     set print_fail 1
     set no_message_loc [lsearch -exact $args no-message]
@@ -617,11 +673,11 @@ proc gdb_internal_error_resync {} {
     while {$count < 10} {
 	gdb_expect {
 	    -re "Quit this debugging session\\? \\(y or n\\) $" {
-		send_gdb "n\n"
+		send_gdb "n\n" answer
 		incr count
 	    }
 	    -re "Create a core file of GDB\\? \\(y or n\\) $" {
-		send_gdb "n\n"
+		send_gdb "n\n" answer
 		incr count
 	    }
 	    -re "$gdb_prompt $" {
@@ -639,7 +695,7 @@ proc gdb_internal_error_resync {} {
 }
 
 
-# gdb_test_multiple COMMAND MESSAGE EXPECT_ARGUMENTS
+# gdb_test_multiple COMMAND MESSAGE EXPECT_ARGUMENTS PROMPT_REGEXP
 # Send a command to gdb; test the result.
 #
 # COMMAND is the command to execute, send to GDB with send_gdb.  If
@@ -651,6 +707,8 @@ proc gdb_internal_error_resync {} {
 #   context; action elements will be executed in the caller's context.
 #   Unlike patterns for gdb_test, these patterns should generally include
 #   the final newline and prompt.
+# PROMPT_REGEXP is a regexp matching the expected prompt after the command
+#   output.  If empty, defaults to "$gdb_prompt $"
 #
 # Returns:
 #    1 if the test failed, according to a built-in failure pattern
@@ -661,10 +719,24 @@ proc gdb_internal_error_resync {} {
 #
 # gdb_test_multiple "print foo" "test foo" {
 #    -re "expected output 1" {
-#        pass "print foo"
+#        pass "test foo"
+#    }
+#    -re "expected output 2" {
+#        fail "test foo"
+#    }
+# }
+#
+# Within action elements you can also make use of the variable
+# gdb_test_name.  This variable is setup automatically by
+# gdb_test_multiple, and contains the value of MESSAGE.  You can then
+# write this, which is equivalent to the above:
+#
+# gdb_test_multiple "print foo" "test foo" {
+#    -re "expected output 1" {
+#        pass $gdb_test_name
 #    }
 #    -re "expected output 2" {
-#        fail "print foo"
+#        fail $gdb_test_name
 #    }
 # }
 #
@@ -688,7 +760,7 @@ proc gdb_internal_error_resync {} {
 # expected from $gdb_spawn_id.  IOW, callers do not need to worry
 # about resetting "-i" back to $gdb_spawn_id explicitly.
 #
-proc gdb_test_multiple { command message user_code } {
+proc gdb_test_multiple { command message user_code { prompt_regexp "" } } {
     global verbose use_gdb_stub
     global gdb_prompt pagination_prompt
     global GDB
@@ -698,6 +770,10 @@ proc gdb_test_multiple { command message user_code } {
     upvar expect_out expect_out
     global any_spawn_id
 
+    if { "$prompt_regexp" == "" } {
+	set prompt_regexp "$gdb_prompt $"
+    }
+
     if { $message == "" } {
 	set message $command
     }
@@ -850,11 +926,14 @@ proc gdb_test_multiple { command message user_code } {
 	}
     }
     append code $processed_code
+
+    # Reset the spawn id, in case the processed code used -i.
     append code {
-	# Reset the spawn id, in case the processed code used -i.
 	-i "$gdb_spawn_id"
+    }
 
-	-re "Ending remote debugging.*$gdb_prompt $" {
+    append code {
+	-re "Ending remote debugging.*$prompt_regexp" {
 	    if ![isnative] then {
 		warning "Can`t communicate to remote target."
 	    }
@@ -862,17 +941,17 @@ proc gdb_test_multiple { command message user_code } {
 	    gdb_start
 	    set result -1
 	}
-	-re "Undefined\[a-z\]* command:.*$gdb_prompt $" {
+	-re "Undefined\[a-z\]* command:.*$prompt_regexp" {
 	    perror "Undefined command \"$command\"."
 	    fail "$message"
 	    set result 1
 	}
-	-re "Ambiguous command.*$gdb_prompt $" {
+	-re "Ambiguous command.*$prompt_regexp" {
 	    perror "\"$command\" is not a unique command name."
 	    fail "$message"
 	    set result 1
 	}
-	-re "$inferior_exited_re with code \[0-9\]+.*$gdb_prompt $" {
+	-re "$inferior_exited_re with code \[0-9\]+.*$prompt_regexp" {
 	    if ![string match "" $message] then {
 		set errmsg "$message (the program exited)"
 	    } else {
@@ -881,7 +960,7 @@ proc gdb_test_multiple { command message user_code } {
 	    fail "$errmsg"
 	    set result -1
 	}
-	-re "$inferior_exited_re normally.*$gdb_prompt $" {
+	-re "$inferior_exited_re normally.*$prompt_regexp" {
 	    if ![string match "" $message] then {
 		set errmsg "$message (the program exited)"
 	    } else {
@@ -890,7 +969,7 @@ proc gdb_test_multiple { command message user_code } {
 	    fail "$errmsg"
 	    set result -1
 	}
-	-re "The program is not being run.*$gdb_prompt $" {
+	-re "The program is not being run.*$prompt_regexp" {
 	    if ![string match "" $message] then {
 		set errmsg "$message (the program is no longer running)"
 	    } else {
@@ -899,7 +978,7 @@ proc gdb_test_multiple { command message user_code } {
 	    fail "$errmsg"
 	    set result -1
 	}
-	-re "\r\n$gdb_prompt $" {
+	-re "\r\n$prompt_regexp" {
 	    if ![string match "" $message] then {
 		fail "$message"
 	    }
@@ -912,19 +991,32 @@ proc gdb_test_multiple { command message user_code } {
 	    set result -1
 	}
 	-re "\\((y or n|y or \\\[n\\\]|\\\[y\\\] or n)\\) " {
-	    send_gdb "n\n"
-	    gdb_expect -re "$gdb_prompt $"
+	    send_gdb "n\n" answer
+	    gdb_expect -re "$prompt_regexp"
 	    fail "$message (got interactive prompt)"
 	    set result -1
 	}
 	-re "\\\[0\\\] cancel\r\n\\\[1\\\] all.*\r\n> $" {
 	    send_gdb "0\n"
-	    gdb_expect -re "$gdb_prompt $"
+	    gdb_expect -re "$prompt_regexp"
 	    fail "$message (got breakpoint menu)"
 	    set result -1
 	}
 
-	# Patterns below apply to any spawn id specified.
+	-i $gdb_spawn_id
+	eof {
+	    perror "GDB process no longer exists"
+	    set wait_status [wait -i $gdb_spawn_id]
+	    verbose -log "GDB process exited with wait status $wait_status"
+	    if { $message != "" } {
+		fail "$message"
+	    }
+	    return -1
+	}
+    }
+
+    # Now patterns that apply to any spawn id specified.
+    append code {
 	-i $any_spawn_id
 	eof {
 	    perror "Process no longer exists"
@@ -946,8 +1038,42 @@ proc gdb_test_multiple { command message user_code } {
 	}
     }
 
+    # remote_expect calls the eof section if there is an error on the
+    # expect call.  We already have eof sections above, and we don't
+    # want them to get called in that situation.  Since the last eof
+    # section becomes the error section, here we define another eof
+    # section, but with an empty spawn_id list, so that it won't ever
+    # match.
+    append code {
+	-i "" eof {
+	    # This comment is here because the eof section must not be
+	    # the empty string, otherwise remote_expect won't realize
+	    # it exists.
+	}
+    }
+
+    # Create gdb_test_name in the parent scope.  If this variable
+    # already exists, which it might if we have nested calls to
+    # gdb_test_multiple, then preserve the old value, otherwise,
+    # create a new variable in the parent scope.
+    upvar gdb_test_name gdb_test_name
+    if { [info exists gdb_test_name] } {
+	set gdb_test_name_old "$gdb_test_name"
+    }
+    set gdb_test_name "$message"
+
     set result 0
     set code [catch {gdb_expect $code} string]
+
+    # Clean up the gdb_test_name variable.  If we had a
+    # previous value then restore it, otherwise, delete the variable
+    # from the parent scope.
+    if { [info exists gdb_test_name_old] } {
+	set gdb_test_name "$gdb_test_name_old"
+    } else {
+	unset gdb_test_name
+    }
+
     if {$code == 1} {
 	global errorInfo errorCode
 	return -code error -errorinfo $errorInfo -errorcode $errorCode $string
@@ -991,24 +1117,66 @@ proc gdb_test { args } {
     set command [lindex $args 0]
     set pattern [lindex $args 1]
 
-    if [llength $args]==5 {
+    set user_code {}
+    lappend user_code {
+	-re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" {
+	    if ![string match "" $message] then {
+		pass "$message"
+            }
+        }
+    }
+
+    if { [llength $args] == 5 } {
 	set question_string [lindex $args 3]
 	set response_string [lindex $args 4]
+	lappend user_code {
+	    -re "(${question_string})$" {
+		send_gdb "$response_string\n"
+		exp_continue
+	    }
+	}
+     }
+
+    set user_code [join $user_code]
+    return [gdb_test_multiple $command $message $user_code]
+}
+
+# Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR.
+proc version_at_least { major minor at_least_major at_least_minor} {
+    if { $major > $at_least_major } {
+        return 1
+    } elseif { $major == $at_least_major \
+		   && $minor >= $at_least_minor } {
+        return 1
     } else {
-	set question_string "^FOOBAR$"
+        return 0
     }
+}
 
-    return [gdb_test_multiple $command $message {
-	-re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
-	    if ![string match "" $message] then {
-		pass "$message"
-            }
+# Return 1 if tcl version used is at least MAJOR.MINOR
+proc tcl_version_at_least { major minor } {
+    global tcl_version
+    regexp {^([0-9]+)\.([0-9]+)$} $tcl_version \
+	dummy tcl_version_major tcl_version_minor
+    return [version_at_least $tcl_version_major $tcl_version_minor \
+		$major $minor]
+}
+
+if { [tcl_version_at_least 8 5] == 0 } {
+    # lrepeat was added in tcl 8.5.  Only add if missing.
+    proc lrepeat { n element } {
+        if { [string is integer -strict $n] == 0 } {
+            error "expected integer but got \"$n\""
         }
-	-re "(${question_string})$" {
-	    send_gdb "$response_string\n"
-	    exp_continue
-	}
-     }]
+        if { $n < 0 } {
+            error "bad count \"$n\": must be integer >= 0"
+        }
+        set res [list]
+        for {set i 0} {$i < $n} {incr i} {
+            lappend res $element
+        }
+        return $res
+    }
 }
 
 # gdb_test_no_output COMMAND MESSAGE
@@ -1042,7 +1210,8 @@ proc gdb_test_no_output { args } {
 # This is useful when the sequence is long and contains ".*", a single
 # regexp to match the entire output can get a timeout much easier.
 #
-# COMMAND is the command to send.
+# COMMAND is the command to execute, send to GDB with send_gdb.  If
+#   this is the null string no command is sent.
 # TEST_NAME is passed to pass/fail.  COMMAND is used if TEST_NAME is "".
 # EXPECTED_OUTPUT_LIST is a list of regexps of expected output, which are
 # processed in order, and all must be present in the output.
@@ -1065,7 +1234,9 @@ proc gdb_test_sequence { command test_name expected_output_list } {
 	set test_name $command
     }
     lappend expected_output_list ""; # implicit ".*" before gdb prompt
-    send_gdb "$command\n"
+    if { $command != "" } {
+	send_gdb "$command\n"
+    }
     return [gdb_expect_list $test_name "$gdb_prompt $" $expected_output_list]
 }
 
@@ -1301,6 +1472,36 @@ proc gdb_test_stdio {command inferior_pattern {gdb_pattern ""} {message ""}} {
     return $res
 }
 
+# get_print_expr_at_depths EXP OUTPUTS
+#
+# Used for testing 'set print max-depth'.  Prints the expression EXP
+# with 'set print max-depth' set to various depths.  OUTPUTS is a list
+# of `n` different patterns to match at each of the depths from 0 to
+# (`n` - 1).
+#
+# This proc does one final check with the max-depth set to 'unlimited'
+# which is tested against the last pattern in the OUTPUTS list.  The
+# OUTPUTS list is therefore required to match every depth from 0 to a
+# depth where the whole of EXP is printed with no ellipsis.
+#
+# This proc leaves the 'set print max-depth' set to 'unlimited'.
+proc gdb_print_expr_at_depths {exp outputs} {
+    for { set depth 0 } { $depth <= [llength $outputs] } { incr depth } {
+	if { $depth == [llength $outputs] } {
+	    set expected_result [lindex $outputs [expr [llength $outputs] - 1]]
+	    set depth_string "unlimited"
+	} else {
+	    set expected_result [lindex $outputs $depth]
+	    set depth_string $depth
+	}
+
+	with_test_prefix "exp='$exp': depth=${depth_string}" {
+	    gdb_test_no_output "set print max-depth ${depth_string}"
+	    gdb_test "p $exp" "$expected_result"
+	}
+    }
+}
+
 
 
 # Issue a PASS and return true if evaluating CONDITION in the caller's
@@ -1332,7 +1533,7 @@ proc gdb_reinitialize_dir { subdir } {
     send_gdb "dir\n"
     gdb_expect 60 {
 	-re "Reinitialize source path to empty.*y or n. " {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    gdb_expect 60 {
 		-re "Source directories searched.*$gdb_prompt $" {
 		    send_gdb "dir $subdir\n"
@@ -1392,7 +1593,7 @@ proc default_gdb_exit {} {
 	send_gdb "quit\n"
 	gdb_expect 10 {
 	    -re "y or n" {
-		send_gdb "y\n"
+		send_gdb "y\n" answer
 		exp_continue
 	    }
 	    -re "DOSEXIT code" { }
@@ -1449,11 +1650,12 @@ proc gdb_file_cmd { arg } {
     }
 
     # The file command used to kill the remote target.  For the benefit
-    # of the testsuite, preserve this behavior.
-    send_gdb "kill\n"
+    # of the testsuite, preserve this behavior.  Mark as optional so it doesn't
+    # get written to the stdin log.
+    send_gdb "kill\n" optional
     gdb_expect 120 {
 	-re "Kill the program being debugged. .y or n. $" {
-	    send_gdb "y\n"
+	    send_gdb "y\n" answer
 	    verbose "\t\tKilling previous program being debugged"
 	    exp_continue
 	}
@@ -1464,25 +1666,25 @@ proc gdb_file_cmd { arg } {
 
     send_gdb "file $arg\n"
     gdb_expect 120 {
-	-re "Reading symbols from.*LZMA support was disabled.*done.*$gdb_prompt $" {
+	-re "Reading symbols from.*LZMA support was disabled.*$gdb_prompt $" {
 	    verbose "\t\tLoaded $arg into $GDB; .gnu_debugdata found but no LZMA available"
 	    set gdb_file_cmd_debug_info "lzma"
 	    return 0
 	}
-	-re "Reading symbols from.*no debugging symbols found.*done.*$gdb_prompt $" {
+	-re "Reading symbols from.*no debugging symbols found.*$gdb_prompt $" {
 	    verbose "\t\tLoaded $arg into $GDB with no debugging symbols"
 	    set gdb_file_cmd_debug_info "nodebug"
 	    return 0
 	}
-        -re "Reading symbols from.*done.*$gdb_prompt $" {
+        -re "Reading symbols from.*$gdb_prompt $" {
             verbose "\t\tLoaded $arg into $GDB"
 	    set gdb_file_cmd_debug_info "debug"
 	    return 0
         }
         -re "Load new symbol table from \".*\".*y or n. $" {
-            send_gdb "y\n"
+            send_gdb "y\n" answer
             gdb_expect 120 {
-                -re "Reading symbols from.*done.*$gdb_prompt $" {
+                -re "Reading symbols from.*$gdb_prompt $" {
                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
 		    set gdb_file_cmd_debug_info "debug"
 		    return 0
@@ -1544,6 +1746,7 @@ proc default_gdb_spawn { } {
     set use_gdb_stub [target_info exists use_gdb_stub]
 
     verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS"
+    gdb_write_cmd_file "$GDB $INTERNAL_GDBFLAGS $GDBFLAGS"
 
     if [info exists gdb_spawn_id] {
 	return 0
@@ -1568,7 +1771,7 @@ proc default_gdb_spawn { } {
 # Default gdb_start procedure.
 
 proc default_gdb_start { } {
-    global gdb_prompt pagination_prompt
+    global gdb_prompt
     global gdb_spawn_id
     global inferior_spawn_id
 
@@ -1576,6 +1779,12 @@ proc default_gdb_start { } {
 	return 0
     }
 
+    # Keep track of the number of times GDB has been launched.
+    global gdb_instances
+    incr gdb_instances
+
+    gdb_stdin_log_init
+
     set res [gdb_spawn]
     if { $res != 0} {
 	return $res
@@ -1589,29 +1798,20 @@ proc default_gdb_start { } {
     # When running over NFS, particularly if running many simultaneous
     # tests on different hosts all using the same server, things can
     # get really slow.  Give gdb at least 3 minutes to start up.
-    set loop_again 1
-    while { $loop_again } {
-	set loop_again 0
-	gdb_expect 360 {
-	    -re "$pagination_prompt" {
-		verbose "Hit pagination during startup. Pressing enter to continue."
-		send_gdb "\n"
-		set loop_again 1
-	    }
-	    -re "\[\r\n\]$gdb_prompt $" {
-		verbose "GDB initialized."
-	    }
-	    -re "$gdb_prompt $"	{
-		perror "GDB never initialized."
-		unset gdb_spawn_id
-		return -1
-	    }
-	    timeout	{
-		perror "(timeout) GDB never initialized after 10 seconds."
-		remote_close host
-		unset gdb_spawn_id
-		return -1
-	    }
+    gdb_expect 360 {
+	-re "\[\r\n\]$gdb_prompt $" {
+	    verbose "GDB initialized."
+	}
+	-re "$gdb_prompt $"	{
+	    perror "GDB never initialized."
+	    unset gdb_spawn_id
+	    return -1
+	}
+	timeout	{
+	    perror "(timeout) GDB never initialized after 10 seconds."
+	    remote_close host
+	    unset gdb_spawn_id
+	    return -1
 	}
     }
 
@@ -1636,6 +1836,8 @@ proc default_gdb_start { } {
 	    warning "Couldn't set the width to 0."
 	}
     }
+
+    gdb_debug_init
     return 0
 }
 
@@ -1742,7 +1944,6 @@ proc skip_rust_tests {} {
 
 proc skip_python_tests_prompt { prompt_regexp } {
     global gdb_py_is_py3k
-    global gdb_py_is_py24
 
     gdb_test_multiple "python print ('test')" "verify python support" {
 	-re "not supported.*$prompt_regexp" {
@@ -1750,9 +1951,8 @@ proc skip_python_tests_prompt { prompt_regexp } {
 	    return 1
 	}
 	-re "$prompt_regexp" {}
-    }
+    } "$prompt_regexp"
 
-    set gdb_py_is_py24 0
     gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" {
 	-re "3.*$prompt_regexp" {
             set gdb_py_is_py3k 1
@@ -1760,17 +1960,7 @@ proc skip_python_tests_prompt { prompt_regexp } {
 	-re ".*$prompt_regexp" {
             set gdb_py_is_py3k 0
         }
-    }
-    if { $gdb_py_is_py3k == 0 } {
-        gdb_test_multiple "python print (sys.version_info\[1\])" "check if python 2.4" {
-	    -re "\[45\].*$prompt_regexp" {
-                set gdb_py_is_py24 1
-            }
-	    -re ".*$prompt_regexp" {
-                set gdb_py_is_py24 0
-            }
-        }
-    }
+    } "$prompt_regexp"
 
     return 0
 }
@@ -1917,7 +2107,16 @@ proc foreach_with_prefix {var list body} {
     upvar 1 $var myvar
     foreach myvar $list {
 	with_test_prefix "$var=$myvar" {
-	    uplevel 1 $body
+	    set code [catch {uplevel 1 $body} result]
+	}
+
+	if {$code == 1} {
+	    global errorInfo errorCode
+	    return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+	} elseif {$code == 3} {
+	    break
+	} elseif {$code == 2} {
+	    return -code $code $result
 	}
     }
 }
@@ -1996,6 +2195,30 @@ proc save_vars { vars body } {
     }
 }
 
+# Run tests in BODY with the current working directory (CWD) set to
+# DIR.  When BODY is finished, restore the original CWD.  Return the
+# result of BODY.
+#
+# This procedure doesn't check if DIR is a valid directory, so you
+# have to make sure of that.
+
+proc with_cwd { dir body } {
+    set saved_dir [pwd]
+    verbose -log "Switching to directory $dir (saved CWD: $saved_dir)."
+    cd $dir
+
+    set code [catch {uplevel 1 $body} result]
+
+    verbose -log "Switching back to $saved_dir."
+    cd $saved_dir
+
+    if {$code == 1} {
+	global errorInfo errorCode
+	return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+    } else {
+	return -code $code $result
+    }
+}
 
 # Run tests in BODY with GDB prompt and variable $gdb_prompt set to
 # PROMPT.  When BODY is finished, restore GDB prompt and variable
@@ -2179,6 +2402,18 @@ proc with_timeout_factor { factor body } {
     }
 }
 
+# Run BODY with timeout factor FACTOR if check-read1 is used.
+
+proc with_read1_timeout_factor { factor body } {
+    if { [info exists ::env(READ1)] == 1 && $::env(READ1) == 1 } {
+	# Use timeout factor
+    } else {
+	# Reset timeout factor
+	set factor 1
+    }
+    return [uplevel [list with_timeout_factor $factor $body]]
+}
+
 # Return 1 if _Complex types are supported, otherwise, return 0.
 
 gdb_caching_proc support_complex_tests {
@@ -2189,35 +2424,16 @@ gdb_caching_proc support_complex_tests {
 	return 0
     }
 
-    # Set up, compile, and execute a test program containing _Complex types.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file complex[pid].c]
-    set exe [standard_temp_file complex[pid].x]
+    # Compile a test program containing _Complex types.
 
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile complex {
 	int main() {
 	    _Complex float cf;
 	    _Complex double cd;
 	    _Complex long double cld;
 	    return 0;
 	}
-    }
-
-    verbose "compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-    file delete $exe
-
-    if ![string match "" $lines] then {
-        verbose "testfile compilation failed, returning 0" 2
-        set result 0
-    } else {
-	set result 1
-    }
-
-    return $result
+    } executable]
 }
 
 # Return 1 if GDB can get a type for siginfo from the target, otherwise
@@ -2312,21 +2528,9 @@ proc readline_is_used { } {
 gdb_caching_proc is_elf_target {
     set me "is_elf_target"
 
-    set src [standard_temp_file is_elf_target[pid].c]
-    set obj [standard_temp_file is_elf_target[pid].o]
-
-    gdb_produce_source $src {
-	int foo () {return 0;}
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-
-    file delete $src
-
-    if ![string match "" $lines] then {
-	verbose "$me:  testfile compilation failed, returning 0" 2
-	return 0
+    set src { int foo () {return 0;} }
+    if {![gdb_simple_compile elf_target $src]} {
+        return 0
     }
 
     set fp_obj [open $obj "r"]
@@ -2379,86 +2583,32 @@ proc gdb_produce_source { name sources } {
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
 gdb_caching_proc is_ilp32_target {
-    set me "is_ilp32_target"
-
-    set src [standard_temp_file ilp32[pid].c]
-    set obj [standard_temp_file ilp32[pid].o]
-
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile is_ilp32_target {
 	int dummy[sizeof (int) == 4
 		  && sizeof (void *) == 4
 		  && sizeof (long) == 4 ? 1 : -1];
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if target is LP64.
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
 gdb_caching_proc is_lp64_target {
-    set me "is_lp64_target"
-
-    set src [standard_temp_file lp64[pid].c]
-    set obj [standard_temp_file lp64[pid].o]
-
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile is_lp64_target {
 	int dummy[sizeof (int) == 4
 		  && sizeof (void *) == 8
 		  && sizeof (long) == 8 ? 1 : -1];
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if target has 64 bit addresses.
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
 gdb_caching_proc is_64_target {
-    set me "is_64_target"
-
-    set src [standard_temp_file is64[pid].c]
-    set obj [standard_temp_file is64[pid].o]
-
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile is_64_target {
 	int function(void) { return 3; }
 	int dummy[sizeof (&function) == 8 ? 1 : -1];
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if target has x86_64 registers - either amd64 or x32.
@@ -2469,30 +2619,14 @@ gdb_caching_proc is_amd64_regs_target {
 	return 0
     }
 
-    set me "is_amd64_regs_target"
+    return [gdb_can_simple_compile is_amd64_regs_target {
+	int main (void) {
+	    asm ("incq %rax");
+	    asm ("incq %r15");
 
-    set src [standard_temp_file reg64[pid].s]
-    set obj [standard_temp_file reg64[pid].o]
-
-    set list {}
-    foreach reg \
-	{rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
-	    lappend list "\tincq %$reg"
+	    return 0;
 	}
-    gdb_produce_source $src [join $list \n]
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if this target is an x86 or x86-64 with -m32.
@@ -2514,30 +2648,13 @@ gdb_caching_proc is_aarch32_target {
 	return 0
     }
 
-    set me "is_aarch32_target"
-
-    set src [standard_temp_file aarch32[pid].s]
-    set obj [standard_temp_file aarch32[pid].o]
-
     set list {}
     foreach reg \
 	{r0 r1 r2 r3} {
 	    lappend list "\tmov $reg, $reg"
 	}
-    gdb_produce_source $src [join $list \n]
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-	verbose "$me:  testfile compilation failed, returning 0" 2
-	return 0
-    }
 
-    verbose "$me:  returning 1" 2
-    return 1
+    return [gdb_can_simple_compile aarch32 [join $list \n]]
 }
 
 # Return 1 if this target is an aarch64, either lp64 or ilp32.
@@ -2578,27 +2695,21 @@ gdb_caching_proc skip_altivec_tests {
     }
 
     # Make sure we have a compiler that understands altivec.
-    set compile_flags {debug nowarnings}
     if [get_compiler_info] {
        warning "Could not get compiler info"
        return 1
     }
     if [test_compiler_info gcc*] {
-        set compile_flags "$compile_flags additional_flags=-maltivec"
+        set compile_flags "additional_flags=-maltivec"
     } elseif [test_compiler_info xlc*] {
-        set compile_flags "$compile_flags additional_flags=-qaltivec"
+        set compile_flags "additional_flags=-qaltivec"
     } else {
         verbose "Could not compile with altivec support, returning 1" 2
         return 1
     }
 
-    # Set up, compile, and execute a test program containing VMX instructions.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file vmx[pid].c]
-    set exe [standard_temp_file vmx[pid].x]
-
-    gdb_produce_source $src {
+    # Compile a test program containing VMX instructions.
+    set src {
 	int main() {
 	    #ifdef __MACH__
 	    asm volatile ("vor v0,v0,v0");
@@ -2608,22 +2719,16 @@ gdb_caching_proc skip_altivec_tests {
 	    return 0;
 	}
     }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
+    if {![gdb_simple_compile $me $src executable $compile_flags]} {
         return 1
     }
 
-    # No error message, compilation succeeded so now run it via gdb.
+    # Compilation succeeded so now run it via gdb.
 
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load "$exe"
+    gdb_load "$obj"
     gdb_run_cmd
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
@@ -2640,7 +2745,7 @@ gdb_caching_proc skip_altivec_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_vmx_tests" 2
     return $skip_vmx_tests
@@ -2662,24 +2767,21 @@ gdb_caching_proc skip_vsx_tests {
     }
 
     # Make sure we have a compiler that understands altivec.
-    set compile_flags {debug nowarnings quiet}
     if [get_compiler_info] {
        warning "Could not get compiler info"
        return 1
     }
     if [test_compiler_info gcc*] {
-        set compile_flags "$compile_flags additional_flags=-mvsx"
+        set compile_flags "additional_flags=-mvsx"
     } elseif [test_compiler_info xlc*] {
-        set compile_flags "$compile_flags additional_flags=-qasm=gcc"
+        set compile_flags "additional_flags=-qasm=gcc"
     } else {
         verbose "Could not compile with vsx support, returning 1" 2
         return 1
     }
 
-    set src [standard_temp_file vsx[pid].c]
-    set exe [standard_temp_file vsx[pid].x]
-
-    gdb_produce_source $src {
+    # Compile a test program containing VSX instructions.
+    set src {
 	int main() {
 	    double a[2] = { 1.0, 2.0 };
 	    #ifdef __MACH__
@@ -2690,13 +2792,7 @@ gdb_caching_proc skip_vsx_tests {
 	    return 0;
 	}
     }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
+    if {![gdb_simple_compile $me $src executable $compile_flags]} {
         return 1
     }
 
@@ -2705,7 +2801,7 @@ gdb_caching_proc skip_vsx_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load "$exe"
+    gdb_load "$obj"
     gdb_run_cmd
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
@@ -2722,7 +2818,7 @@ gdb_caching_proc skip_vsx_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_vsx_tests" 2
     return $skip_vsx_tests
@@ -2736,24 +2832,16 @@ gdb_caching_proc skip_tsx_tests {
 
     set me "skip_tsx_tests"
 
-    set src [standard_temp_file tsx[pid].c]
-    set exe [standard_temp_file tsx[pid].x]
-
-    gdb_produce_source $src {
-    int main() {
-        asm volatile ("xbegin .L0");
-        asm volatile ("xend");
-        asm volatile (".L0: nop");
-        return 0;
-    }
+    # Compile a test program.
+    set src {
+        int main() {
+            asm volatile ("xbegin .L0");
+            asm volatile ("xend");
+            asm volatile (".L0: nop");
+            return 0;
+        }
     }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $exe executable {nowarnings quiet}]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed." 2
+    if {![gdb_simple_compile $me $src executable]} {
         return 1
     }
 
@@ -2762,7 +2850,7 @@ gdb_caching_proc skip_tsx_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load "$exe"
+    gdb_load "$obj"
     gdb_run_cmd
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
@@ -2779,7 +2867,7 @@ gdb_caching_proc skip_tsx_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_tsx_tests" 2
     return $skip_tsx_tests
@@ -2797,24 +2885,10 @@ gdb_caching_proc skip_btrace_tests {
         return 1
     }
 
-    # Set up, compile, and execute a test program.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file btrace[pid].c]
-    set exe [standard_temp_file btrace[pid].x]
-
-    gdb_produce_source $src {
-	int main(void) { return 0; }
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
-	file delete $src
-        return 1
+    # Compile a test program.
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile $me $src executable]} {
+        return 0
     }
 
     # No error message, compilation succeeded so now run it via gdb.
@@ -2822,12 +2896,10 @@ gdb_caching_proc skip_btrace_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load $exe
+    gdb_load $obj
     if ![runto_main] {
-	file delete $src
         return 1
     }
-    file delete $src
     # In case of an unexpected output, we return 2 as a fail value.
     set skip_btrace_tests 2
     gdb_test_multiple "record btrace" "check btrace support" {
@@ -2845,7 +2917,7 @@ gdb_caching_proc skip_btrace_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_btrace_tests" 2
     return $skip_btrace_tests
@@ -2864,24 +2936,10 @@ gdb_caching_proc skip_btrace_pt_tests {
         return 1
     }
 
-    # Set up, compile, and execute a test program.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file btrace[pid].c]
-    set exe [standard_temp_file btrace[pid].x]
-
-    gdb_produce_source $src {
-	int main(void) { return 0; }
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
-	file delete $src
-        return 1
+    # Compile a test program.
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile $me $src executable]} {
+        return 0
     }
 
     # No error message, compilation succeeded so now run it via gdb.
@@ -2889,15 +2947,13 @@ gdb_caching_proc skip_btrace_pt_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load $exe
+    gdb_load $obj
     if ![runto_main] {
-	file delete $src
         return 1
     }
-    file delete $src
     # In case of an unexpected output, we return 2 as a fail value.
     set skip_btrace_tests 2
-    gdb_test_multiple "record btrace pt" "check btrace support" {
+    gdb_test_multiple "record btrace pt" "check btrace pt support" {
         -re "You can't do that when your target is.*\r\n$gdb_prompt $" {
             set skip_btrace_tests 1
         }
@@ -2907,7 +2963,7 @@ gdb_caching_proc skip_btrace_pt_tests {
         -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
             set skip_btrace_tests 1
         }
-        -re "GDB does not support.*\r\n$gdb_prompt $" {
+        -re "support was disabled at compile time.*\r\n$gdb_prompt $" {
             set skip_btrace_tests 1
         }
         -re "^record btrace pt\r\n$gdb_prompt $" {
@@ -2915,12 +2971,94 @@ gdb_caching_proc skip_btrace_pt_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_btrace_tests" 2
     return $skip_btrace_tests
 }
 
+# Run a test on the target to see if it supports Aarch64 SVE hardware.
+# Return 0 if so, 1 if it does not.  Note this causes a restart of GDB.
+
+gdb_caching_proc skip_aarch64_sve_tests {
+    global srcdir subdir gdb_prompt inferior_exited_re
+
+    set me "skip_aarch64_sve_tests"
+
+    if { ![is_aarch64_target]} {
+	return 1
+    }
+
+    set compile_flags "{additional_flags=-march=armv8-a+sve}"
+
+    # Compile a test program containing SVE instructions.
+    set src {
+	int main() {
+	    asm volatile ("ptrue p0.b");
+	    return 0;
+	}
+    }
+    if {![gdb_simple_compile $me $src executable $compile_flags]} {
+        return 1
+    }
+
+    # Compilation succeeded so now run it via gdb.
+    clean_restart $obj
+    gdb_run_cmd
+    gdb_expect {
+        -re ".*Illegal instruction.*${gdb_prompt} $" {
+            verbose -log "\n$me sve hardware not detected"
+            set skip_sve_tests 1
+        }
+        -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+            verbose -log "\n$me: sve hardware detected"
+            set skip_sve_tests 0
+        }
+        default {
+          warning "\n$me: default case taken"
+            set skip_sve_tests 1
+        }
+    }
+    gdb_exit
+    remote_file build delete $obj
+
+    verbose "$me:  returning $skip_sve_tests" 2
+    return $skip_sve_tests
+}
+
+
+# A helper that compiles a test case to see if __int128 is supported.
+proc gdb_int128_helper {lang} {
+    return [gdb_can_simple_compile "i128-for-$lang" {
+	__int128 x;
+	int main() { return 0; }
+    } executable $lang]
+}
+
+# Return true if the C compiler understands the __int128 type.
+gdb_caching_proc has_int128_c {
+    return [gdb_int128_helper c]
+}
+
+# Return true if the C++ compiler understands the __int128 type.
+gdb_caching_proc has_int128_cxx {
+    return [gdb_int128_helper c++]
+}
+
+# Return true if the IFUNC feature is unsupported.
+gdb_caching_proc skip_ifunc_tests {
+    if [gdb_can_simple_compile ifunc {
+	extern void f_ ();
+	typedef void F (void);
+	F* g (void) { return &f_; }
+	void f () __attribute__ ((ifunc ("g")));
+    } object] {
+	return 0
+    } else {
+	return 1
+    }
+}
+
 # Return whether we should skip tests for showing inlined functions in
 # backtraces.  Requires get_compiler_info and get_debug_format.
 
@@ -3058,22 +3196,28 @@ proc skip_unwinder_tests {} {
     return $ok
 }
 
-# Return 0 if we should skip tests that require the libstdc++ stap
+# Return 1 if we should skip tests that require the libstdc++ stap
 # probes.  This must be invoked while gdb is running, after shared
-# libraries have been loaded.
-
-proc skip_libstdcxx_probe_tests {} {
-    global gdb_prompt
+# libraries have been loaded.  PROMPT_REGEXP is the expected prompt.
 
-    set ok 0
+proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } {
+    set supported 0
     gdb_test_multiple "info probe" "check for stap probe in libstdc++" {
-	-re ".*libstdcxx.*catch.*\r\n$gdb_prompt $" {
-	    set ok 1
+	-re ".*libstdcxx.*catch.*\r\n$prompt_regexp" {
+	    set supported 1
 	}
-	-re "\r\n$gdb_prompt $" {
+	-re "\r\n$prompt_regexp" {
 	}
-    }
-    return $ok
+    } "$prompt_regexp"
+    set skip [expr !$supported]
+    return $skip
+}
+
+# As skip_libstdcxx_probe_tests_prompt, with gdb_prompt.
+
+proc skip_libstdcxx_probe_tests {} {
+    global gdb_prompt
+    return [skip_libstdcxx_probe_tests_prompt "$gdb_prompt $"]
 }
 
 # Return 1 if we should skip tests of the "compile" feature.
@@ -3096,33 +3240,49 @@ proc skip_compile_feature_tests {} {
     return $result
 }
 
-# Helper for gdb_is_target_remote.  PROMPT_REGEXP is the expected
-# prompt.
-
-proc gdb_is_target_remote_prompt { prompt_regexp } {
+# Helper for gdb_is_target_* procs.  TARGET_NAME is the name of the target
+# we're looking for (used to build the test name).  TARGET_STACK_REGEXP
+# is a regexp that will match the output of "maint print target-stack" if
+# the target in question is currently pushed.  PROMPT_REGEXP is a regexp
+# matching the expected prompt after the command output.
 
-    set test "probe for target remote"
+proc gdb_is_target_1 { target_name target_stack_regexp prompt_regexp } {
+    set test "probe for target ${target_name}"
     gdb_test_multiple "maint print target-stack" $test {
-	-re ".*emote serial target in gdb-specific protocol.*$prompt_regexp" {
+	-re "${target_stack_regexp}${prompt_regexp}" {
 	    pass $test
 	    return 1
 	}
 	-re "$prompt_regexp" {
 	    pass $test
 	}
-    }
+    } "$prompt_regexp"
     return 0
 }
 
+# Helper for gdb_is_target_remote where the expected prompt is variable.
+
+proc gdb_is_target_remote_prompt { prompt_regexp } {
+    return [gdb_is_target_1 "remote" ".*emote serial target in gdb-specific protocol.*" $prompt_regexp]
+}
+
 # Check whether we're testing with the remote or extended-remote
 # targets.
 
-proc gdb_is_target_remote {} {
+proc gdb_is_target_remote { } {
     global gdb_prompt
 
     return [gdb_is_target_remote_prompt "$gdb_prompt $"]
 }
 
+# Check whether we're testing with the native target.
+
+proc gdb_is_target_native { } {
+    global gdb_prompt
+
+    return [gdb_is_target_1 "native" ".*native \\(Native process\\).*" "$gdb_prompt $"]
+}
+
 # Return the effective value of use_gdb_stub.
 #
 # If the use_gdb_stub global has been set (it is set when the gdb process is
@@ -3263,12 +3423,12 @@ proc get_compiler_info {{arg ""}} {
 	# We have to use -E and -o together, despite the comments
 	# above, because of how DejaGnu handles remote host testing.
 	set ppout "$outdir/compiler.i"
-	gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet]
+	gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet getting_compiler_info]
 	set file [open $ppout r]
 	set cppout [read $file]
 	close $file
     } else {
-	set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet] ]
+	set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet getting_compiler_info] ]
     }
     eval log_file $saved_log
 
@@ -3367,6 +3527,85 @@ proc gdb_wrapper_init { args } {
     set gdb_wrapper_target [current_target_name]
 }
 
+# Determine options that we always want to pass to the compiler.
+gdb_caching_proc universal_compile_options {
+    set me "universal_compile_options"
+    set options {}
+
+    set src [standard_temp_file ccopts[pid].c]
+    set obj [standard_temp_file ccopts[pid].o]
+
+    gdb_produce_source $src {
+	int foo(void) { return 0; }
+    }
+
+    # Try an option for disabling colored diagnostics.  Some compilers
+    # yield colored diagnostics by default (when run from a tty) unless
+    # such an option is specified.
+    set opt "additional_flags=-fdiagnostics-color=never"
+    set lines [target_compile $src $obj object [list "quiet" $opt]]
+    if [string match "" $lines] then {
+	# Seems to have worked; use the option.
+	lappend options $opt
+    }
+    file delete $src
+    file delete $obj
+
+    verbose "$me:  returning $options" 2
+    return $options
+}
+
+# Compile the code in $code to a file based on $name, using the flags
+# $compile_flag as well as debug, nowarning and quiet.
+# Return 1 if code can be compiled
+# Leave the file name of the resulting object in the upvar object.
+
+proc gdb_simple_compile {name code {type object} {compile_flags {}} {object obj}} {
+    upvar $object obj
+
+    switch -regexp -- $type {
+        "executable" {
+            set postfix "x"
+        }
+        "object" {
+            set postfix "o"
+        }
+        "preprocess" {
+            set postfix "i"
+        }
+        "assembly" {
+            set postfix "s"
+        }
+    }
+    set src [standard_temp_file $name-[pid].c]
+    set obj [standard_temp_file $name-[pid].$postfix]
+    set compile_flags [concat $compile_flags {debug nowarnings quiet}]
+
+    gdb_produce_source $src $code
+
+    verbose "$name:  compiling testfile $src" 2
+    set lines [gdb_compile $src $obj $type $compile_flags]
+
+    file delete $src
+
+    if ![string match "" $lines] then {
+        verbose "$name:  compilation failed, returning 0" 2
+        return 0
+    }
+    return 1
+}
+
+# Compile the code in $code to a file based on $name, using the flags
+# $compile_flag as well as debug, nowarning and quiet.
+# Return 1 if code can be compiled
+# Delete all created files and objects.
+
+proc gdb_can_simple_compile {name code {type object} {compile_flags ""}} {
+    set ret [gdb_simple_compile $name $code $type $compile_flags temp_obj]
+    file delete $temp_obj
+    return $ret
+}
+
 # Some targets need to always link a special object in.  Save its path here.
 global gdb_saved_set_unbuffered_mode_obj
 set gdb_saved_set_unbuffered_mode_obj ""
@@ -3390,6 +3629,8 @@ set gdb_saved_set_unbuffered_mode_obj ""
 #     dynamically load libraries at runtime.  For example, on Linux, this adds
 #     -ldl so that the test can use dlopen.
 #   - nowarnings:  Inhibit all compiler warnings.
+#   - pie: Force creation of PIE executables.
+#   - nopie: Prevent creation of PIE executables.
 #
 # And here are some of the not too obscure options understood by DejaGnu that
 # influence the compilation:
@@ -3418,11 +3659,18 @@ proc gdb_compile {source dest type options} {
 
     # Add platform-specific options if a shared library was specified using
     # "shlib=librarypath" in OPTIONS.
-    set new_options ""
+    set new_options {}
+    if {[lsearch -exact $options rust] != -1} {
+	# -fdiagnostics-color is not a rustcc option.
+    } else {
+	set new_options [universal_compile_options]
+    }
     set shlib_found 0
     set shlib_load 0
+    set getting_compiler_info 0
     foreach opt $options {
-        if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] {
+        if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name]
+	    && $type == "executable"} {
             if [test_compiler_info "xlc-*"] {
 		# IBM xlc compiler doesn't accept shared library named other
 		# than .so: use "-Wl," to bypass this
@@ -3448,13 +3696,29 @@ proc gdb_compile {source dest type options} {
 		    lappend new_options "early_flags=-Wl,--no-as-needed"
 		}
             }
-	} elseif { $opt == "shlib_load" } {
+	} elseif { $opt == "shlib_load" && $type == "executable" } {
 	    set shlib_load 1
+	} elseif { $opt == "getting_compiler_info" } {
+	    # If this is set, calling test_compiler_info will cause recursion.
+	    set getting_compiler_info 1
         } else {
             lappend new_options $opt
         }
     }
 
+    # Ensure stack protector is disabled for GCC, as this causes problems with
+    # DWARF line numbering.
+    # See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88432
+    # This option defaults to on for Debian/Ubuntu.
+    if { $getting_compiler_info == 0
+	 && [test_compiler_info {gcc-*-*}]
+	 && !([test_compiler_info {gcc-[0-3]-*}]
+	      || [test_compiler_info {gcc-4-0-*}])
+	 && [lsearch -exact $options rust] == -1} {
+        # Put it at the front to not override any user-provided value.
+        lappend new_options "early_flags=-fno-stack-protector"
+    }
+
     # Because we link with libraries using their basename, we may need
     # (depending on the platform) to set a special rpath value, to allow
     # the executable to find the libraries it depends on.
@@ -3505,6 +3769,43 @@ proc gdb_compile {source dest type options} {
 	set options [lreplace $options $nowarnings $nowarnings $flag]
     }
 
+    # Replace the "pie" option with the appropriate compiler and linker flags
+    # to enable PIE executables.
+    set pie [lsearch -exact $options pie]
+    if {$pie != -1} {
+	if [target_info exists gdb,pie_flag] {
+	    set flag "additional_flags=[target_info gdb,pie_flag]"
+	} else {
+	    # For safety, use fPIE rather than fpie. On AArch64, m68k, PowerPC
+	    # and SPARC, fpie can cause compile errors due to the GOT exceeding
+	    # a maximum size.  On other architectures the two flags are
+	    # identical (see the GCC manual). Note Debian9 and Ubuntu16.10
+	    # onwards default GCC to using fPIE.  If you do require fpie, then
+	    # it can be set using the pie_flag.
+	    set flag "additional_flags=-fPIE"
+	}
+	set options [lreplace $options $pie $pie $flag]
+
+	if [target_info exists gdb,pie_ldflag] {
+	    set flag "ldflags=[target_info gdb,pie_ldflag]"
+	} else {
+	    set flag "ldflags=-pie"
+	}
+	lappend options "$flag"
+    }
+
+    # Replace the "nopie" option with the appropriate linker flag to disable
+    # PIE executables.  There are no compiler flags for this option.
+    set nopie [lsearch -exact $options nopie]
+    if {$nopie != -1} {
+	if [target_info exists gdb,nopie_flag] {
+	    set flag "ldflags=[target_info gdb,nopie_flag]"
+	} else {
+	    set flag "ldflags=-no-pie"
+	}
+	set options [lreplace $options $nopie $nopie $flag]
+    }
+
     if { $type == "executable" } {
 	if { ([istarget "*-*-mingw*"]
 	      || [istarget "*-*-*djgpp"]
@@ -3559,6 +3860,16 @@ proc gdb_compile {source dest type options} {
     regsub "\[\r\n\]*$" "$result" "" result
     regsub "^\[\r\n\]*" "$result" "" result
     
+    if { $type == "executable" && $result == "" \
+	     && ($nopie != -1 || $pie != -1) } {
+	set is_pie [exec_is_pie "$dest"]
+	if { $nopie != -1 && $is_pie == 1 } {
+	    set result "nopie failed to prevent PIE executable"
+	} elseif { $pie != -1 && $is_pie == 0 } {
+	    set result "pie failed to generate PIE executable"
+	}
+    }
+
     if {[lsearch $options quiet] < 0} {
 	# We shall update this on a per language basis, to avoid
 	# changing the entire testsuite in one go.
@@ -3650,11 +3961,16 @@ proc gdb_compile_shlib {sources dest options} {
     set outdir [file dirname $dest]
     set objects ""
     foreach source $sources {
-       set sourcebase [file tail $source]
-       if {[gdb_compile $source "${outdir}/${sourcebase}.o" object $obj_options] != ""} {
-           return -1
-       }
-       lappend objects ${outdir}/${sourcebase}.o
+	set sourcebase [file tail $source]
+	if {[file extension $source] == ".o"} {
+	    # Already a .o file.
+	    lappend objects $source
+	} elseif {[gdb_compile $source "${outdir}/${sourcebase}.o" object \
+		       $obj_options] != ""} {
+	    return -1
+	} else {
+	    lappend objects ${outdir}/${sourcebase}.o
+	}
     }
 
     set link_options $options
@@ -3776,11 +4092,15 @@ proc gdb_compile_objc {source dest type options} {
     }
 }
 
-proc send_gdb { string } {
+# Send a command to GDB.
+# For options for TYPE see gdb_stdin_log_write
+
+proc send_gdb { string {type standard}} {
     global suppress_flag
     if { $suppress_flag } {
 	return "suppressed"
     }
+    gdb_stdin_log_write $string $type
     return [remote_send host "$string"]
 }
 
@@ -4320,6 +4640,12 @@ proc gdb_remote_download {dest fromfile {tofile {}}} {
 # Copy the listed library to the target.
 
 proc gdb_load_shlib { file } {
+    global gdb_spawn_id
+
+    if ![info exists gdb_spawn_id] {
+	perror "gdb_load_shlib: GDB is not running"
+    }
+
     set dest [gdb_remote_download target [shlib_target_file $file]]
 
     if {[is_remote target]} {
@@ -4437,9 +4763,27 @@ proc standard_output_file {basename} {
 
     set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name]
     file mkdir $dir
+    # If running on MinGW, replace /c/foo with c:/foo
+    if { [ishost *-*-mingw*] } {
+        set dir [regsub {^/([a-z])/} $dir {\1:/}]
+    }
     return [file join $dir $basename]
 }
 
+# Turn BASENAME into a full file name in the standard output directory.  If
+# GDB has been launched more than once then append the count, starting with
+# a ".1" postfix.
+
+proc standard_output_file_with_gdb_instance {basename} {
+    global gdb_instances
+    set count [expr $gdb_instances - 1 ]
+
+    if {$count == 0} {
+      return [standard_output_file $basename]
+    }
+    return [standard_output_file ${basename}.${count}]
+}
+
 # Return the name of a file in our standard temporary directory.
 
 proc standard_temp_file {basename} {
@@ -4615,10 +4959,14 @@ proc gdb_init { test_file_name } {
     # read from this file.
     setenv INPUTRC "/dev/null"
 
-    # The gdb.base/readline.exp arrow key test relies on the standard VT100
-    # bindings, so make sure that an appropriate terminal is selected.
-    # The same bug doesn't show up if we use ^P / ^N instead.
-    setenv TERM "vt100"
+    # This disables style output, which would interfere with many
+    # tests.
+    setenv TERM "dumb"
+
+    # Initialize GDB's pty with a fixed size, to make sure we avoid pagination
+    # during startup.  See "man expect" for details about stty_init.
+    global stty_init
+    set stty_init "rows 25 cols 80"
 
     # Some tests (for example gdb.base/maint.exp) shell out from gdb to use
     # grep.  Clear GREP_OPTIONS to make the behavior predictable,
@@ -4630,6 +4978,10 @@ proc gdb_init { test_file_name } {
     set gdbserver_reconnect_p 1
     unset gdbserver_reconnect_p
 
+    # Reset GDB number of instances
+    global gdb_instances
+    set gdb_instances 0
+
     return [default_gdb_init $test_file_name]
 }
 
@@ -4898,7 +5250,7 @@ proc rerun_to_main {} {
     send_gdb "run\n"
     gdb_expect {
       -re "The program .* has been started already.*y or n. $" {
-	  send_gdb "y\n"
+	  send_gdb "y\n" answer
 	  exp_continue
       }
       -re "Starting program.*$gdb_prompt $"\
@@ -4910,6 +5262,70 @@ proc rerun_to_main {} {
   }
 }
 
+# Return true if EXECUTABLE contains a .gdb_index or .debug_names index section.
+
+proc exec_has_index_section { executable } {
+    set readelf_program [gdb_find_readelf]
+    set res [catch {exec $readelf_program -S $executable \
+			| grep -E "\.gdb_index|\.debug_names" }]
+    if { $res == 0 } {
+	return 1
+    }
+    return 0
+}
+
+# Return list with major and minor version of readelf, or an empty list.
+gdb_caching_proc readelf_version {
+    set readelf_program [gdb_find_readelf]
+    set res [catch {exec $readelf_program --version} output]
+    if { $res != 0 } {
+	return [list]
+    }
+    set lines [split $output \n]
+    set line [lindex $lines 0]
+    set res [regexp {[ \t]+([0-9]+)[.]([0-9]+)[^ \t]*$} \
+		 $line dummy major minor]
+    if { $res != 1 } {
+	return [list]
+    }
+    return [list $major $minor]
+}
+
+# Return 1 if readelf prints the PIE flag, 0 if is doesn't, and -1 if unknown.
+proc readelf_prints_pie { } {
+    set version [readelf_version]
+    if { [llength $version] == 0 } {
+	return -1
+    }
+    set major [lindex $version 0]
+    set minor [lindex $version 1]
+    # It would be better to construct a PIE executable and test if the PIE
+    # flag is printed by readelf, but we cannot reliably construct a PIE
+    # executable if the multilib_flags dictate otherwise
+    # (--target_board=unix/-no-pie/-fno-PIE).
+    return [version_at_least $major $minor 2 26]
+}
+
+# Return 1 if EXECUTABLE is a Position Independent Executable, 0 if it is not,
+# and -1 if unknown.
+
+proc exec_is_pie { executable } {
+    set res [readelf_prints_pie]
+    if { $res != 1 } {
+	return -1
+    }
+    set readelf_program [gdb_find_readelf]
+    set res [catch {exec $readelf_program -d $executable} output]
+    if { $res != 0 } {
+	return -1
+    }
+    set res [regexp -line {\(FLAGS_1\).*Flags:.* PIE($| )} $output]
+    if { $res == 1 } {
+	return 1
+    }
+    return 0
+}
+
 # Return true if a test should be skipped due to lack of floating
 # point support or GDB can't fetch the contents from floating point
 # registers.
@@ -5029,9 +5445,14 @@ proc gdb_skip_bogus_test { msg } {
 # NOTE: This must be called while gdb is *not* running.
 
 gdb_caching_proc gdb_skip_xml_test {
+    global gdb_spawn_id
     global gdb_prompt
     global srcdir
 
+    if { [info exists gdb_spawn_id] } {
+        error "GDB must not be running in gdb_skip_xml_tests."
+    }
+
     set xml_file [gdb_remote_download host "${srcdir}/gdb.xml/trivial.xml"]
 
     gdb_start
@@ -5051,18 +5472,13 @@ gdb_caching_proc gdb_skip_xml_test {
 gdb_caching_proc gdb_has_argv0 {
     set result 0
 
-    # Set up, compile, and execute a test program to check whether
-    # argv[0] is available.
-    set src [standard_temp_file has_argv0[pid].c]
-    set exe [standard_temp_file has_argv0[pid].x]
-
-    gdb_produce_source $src {
+    # Compile and execute a test program to check whether argv[0] is available.
+    gdb_simple_compile has_argv0 {
 	int main (int argc, char **argv) {
 	    return 0;
 	}
-    }
+    } executable
 
-    gdb_compile $src $exe executable {debug}
 
     # Helper proc.
     proc gdb_has_argv0_1 { exe } {
@@ -5133,11 +5549,10 @@ gdb_caching_proc gdb_has_argv0 {
 	return $retval
     }
 
-    set result [gdb_has_argv0_1 $exe]
+    set result [gdb_has_argv0_1 $obj]
 
     gdb_exit
-    file delete $src
-    file delete $exe
+    file delete $obj
 
     if { !$result
       && ([istarget *-*-linux*]
@@ -5310,35 +5725,64 @@ proc gdb_gnu_strip_debug { dest args } {
 # Test the output of GDB_COMMAND matches the pattern obtained
 # by concatenating all elements of EXPECTED_LINES.  This makes
 # it possible to split otherwise very long string into pieces.
-# If third argument is not empty, it's used as the name of the
+# If third argument TESTNAME is not empty, it's used as the name of the
 # test to be printed on pass/fail.
-proc help_test_raw { gdb_command expected_lines args } {
-    set message $gdb_command
-    if [llength $args]>0 then {
-	set message [lindex $args 0]
-    } 
+proc help_test_raw { gdb_command expected_lines {testname {}} } {
+    if {$testname == {}} {
+	set message $gdb_command
+    } else {
+	set message $testname
+    }
     set expected_output [join $expected_lines ""]
     gdb_test "${gdb_command}" "${expected_output}" $message
 }
 
-# Test the output of "help COMMAND_CLASS". EXPECTED_INITIAL_LINES
+# A regexp that matches the end of help CLASS|PREFIX_COMMAND
+set help_list_trailer {
+    "Type \"apropos word\" to search for commands related to \"word\"\.[\r\n]+"
+    "Type \"apropos -v word\" for full documentation of commands related to \"word\"\.[\r\n]+"
+    "Command name abbreviations are allowed if unambiguous\."
+}
+
+# Test the output of "help COMMAND_CLASS".  EXPECTED_INITIAL_LINES
 # are regular expressions that should match the beginning of output,
-# before the list of commands in that class.  The presence of 
-# command list and standard epilogue will be tested automatically.
+# before the list of commands in that class.
+# LIST_OF_COMMANDS are regular expressions that should match the
+# list of commands in that class.  If empty, the command list will be
+# matched automatically.  The presence of standard epilogue will be tested
+# automatically.
+# If last argument TESTNAME is not empty, it's used as the name of the
+# test to be printed on pass/fail.
 # Notice that the '[' and ']' characters don't need to be escaped for strings
 # wrapped in {} braces.
-proc test_class_help { command_class expected_initial_lines args } {
+proc test_class_help { command_class expected_initial_lines {list_of_commands {}} {testname {}} } {
+    global help_list_trailer
+    if {[llength $list_of_commands]>0} {
+	set l_list_of_commands {"List of commands:[\r\n]+[\r\n]+"}
+        set l_list_of_commands [concat $l_list_of_commands $list_of_commands]
+	set l_list_of_commands [concat $l_list_of_commands {"[\r\n]+[\r\n]+"}]
+    } else {
+        set l_list_of_commands {"List of commands\:.*[\r\n]+"}
+    }
     set l_stock_body {
-        "List of commands\:.*[\r\n]+"
         "Type \"help\" followed by command name for full documentation\.[\r\n]+"
-        "Type \"apropos word\" to search for commands related to \"word\"\.[\r\n]+"
-        "Command name abbreviations are allowed if unambiguous\." 
     }
-    set l_entire_body [concat $expected_initial_lines $l_stock_body]
+    set l_entire_body [concat $expected_initial_lines $l_list_of_commands \
+		       $l_stock_body $help_list_trailer]
+
+    help_test_raw "help ${command_class}" $l_entire_body $testname
+}
 
-    eval [list help_test_raw "help ${command_class}" $l_entire_body] $args
+# Like test_class_help but specialised to test "help user-defined".
+proc test_user_defined_class_help { {list_of_commands {}} {testname {}} } {
+    test_class_help "user-defined" {
+	"User-defined commands\.[\r\n]+"
+	"The commands in this class are those defined by the user\.[\r\n]+"
+	"Use the \"define\" command to define a command\.[\r\n]+"
+    } $list_of_commands $testname
 }
 
+
 # COMMAND_LIST should have either one element -- command to test, or
 # two elements -- abbreviated command to test, and full command the first
 # element is abbreviation of.
@@ -5347,6 +5791,7 @@ proc test_class_help { command_class expected_initial_lines args } {
 # before the list of subcommands.  The presence of 
 # subcommand list and standard epilogue will be tested automatically.
 proc test_prefix_command_help { command_list expected_initial_lines args } {
+    global help_list_trailer
     set command [lindex $command_list 0]   
     if {[llength $command_list]>1} {        
         set full_command [lindex $command_list 1]
@@ -5357,10 +5802,8 @@ proc test_prefix_command_help { command_list expected_initial_lines args } {
     # be expanded in this list.
     set l_stock_body [list\
          "List of $full_command subcommands\:.*\[\r\n\]+"\
-         "Type \"help $full_command\" followed by $full_command subcommand name for full documentation\.\[\r\n\]+"\
-         "Type \"apropos word\" to search for commands related to \"word\"\.\[\r\n\]+"\
-         "Command name abbreviations are allowed if unambiguous\."]
-    set l_entire_body [concat $expected_initial_lines $l_stock_body]
+         "Type \"help $full_command\" followed by $full_command subcommand name for full documentation\.\[\r\n\]+"]
+    set l_entire_body [concat $expected_initial_lines $l_stock_body $help_list_trailer]
     if {[llength $args]>0} {
         help_test_raw "help ${command}" $l_entire_body [lindex $args 0]
     } else {
@@ -5517,15 +5960,23 @@ proc prepare_for_testing { testname executable {sources ""} {options {debug}}} {
     return 0
 }
 
-proc get_valueof { fmt exp default } {
+# Retrieve the value of EXP in the inferior, represented in format
+# specified in FMT (using "printFMT").  DEFAULT is used as fallback if
+# print fails.  TEST is the test message to use.  It can be omitted,
+# in which case a test message is built from EXP.
+
+proc get_valueof { fmt exp default {test ""} } {
     global gdb_prompt
 
-    set test "get valueof \"${exp}\""
+    if {$test == "" } {
+	set test "get valueof \"${exp}\""
+    }
+
     set val ${default}
     gdb_test_multiple "print${fmt} ${exp}" "$test" {
-	-re "\\$\[0-9\]* = (.*)\[\r\n\]*$gdb_prompt $" {
+	-re "\\$\[0-9\]* = (\[^\r\n\]*)\[\r\n\]*$gdb_prompt $" {
 	    set val $expect_out(1,string)
-	    pass "$test ($val)"
+	    pass "$test"
 	}
 	timeout {
 	    fail "$test (timeout)"
@@ -5534,15 +5985,23 @@ proc get_valueof { fmt exp default } {
     return ${val}
 }
 
-proc get_integer_valueof { exp default } {
+# Retrieve the value of EXP in the inferior, as a signed decimal value
+# (using "print /d").  DEFAULT is used as fallback if print fails.
+# TEST is the test message to use.  It can be omitted, in which case
+# a test message is built from EXP.
+
+proc get_integer_valueof { exp default {test ""} } {
     global gdb_prompt
 
-    set test "get integer valueof \"${exp}\""
+    if {$test == ""} {
+	set test "get integer valueof \"${exp}\""
+    }
+
     set val ${default}
     gdb_test_multiple "print /d ${exp}" "$test" {
 	-re "\\$\[0-9\]* = (\[-\]*\[0-9\]*).*$gdb_prompt $" {
 	    set val $expect_out(1,string)
-	    pass "$test ($val)"
+	    pass "$test"
 	}
 	timeout {
 	    fail "$test (timeout)"
@@ -5553,7 +6012,7 @@ proc get_integer_valueof { exp default } {
 
 # Retrieve the value of EXP in the inferior, as an hexadecimal value
 # (using "print /x").  DEFAULT is used as fallback if print fails.
-# TEST is the test message to use.  If can be ommitted, in which case
+# TEST is the test message to use.  It can be omitted, in which case
 # a test message is built from EXP.
 
 proc get_hexadecimal_valueof { exp default {test ""} } {
@@ -5573,8 +6032,12 @@ proc get_hexadecimal_valueof { exp default {test ""} } {
     return ${val}
 }
 
-proc get_sizeof { type default } {
-    return [get_integer_valueof "sizeof (${type})" $default]
+# Retrieve the size of TYPE in the inferior, as a decimal value.  DEFAULT
+# is used as fallback if print fails.  TEST is the test message to use.
+# It can be omitted, in which case a test message is 'sizeof (TYPE)'.
+
+proc get_sizeof { type default {test ""} } {
+    return [get_integer_valueof "sizeof (${type})" $default $test]
 }
 
 proc get_target_charset { } {
@@ -5618,6 +6081,22 @@ proc get_var_address { var } {
     return ""
 }
 
+# Return the frame number for the currently selected frame
+proc get_current_frame_number {{test_name ""}} {
+    global gdb_prompt
+
+    if { $test_name == "" } {
+	set test_name "get current frame number"
+    }
+    set frame_num -1
+    gdb_test_multiple "frame" $test_name {
+	-re "#(\[0-9\]+) .*$gdb_prompt $" {
+	    set frame_num $expect_out(1,string)
+	}
+    }
+    return $frame_num
+}
+
 # Get the current value for remotetimeout and return it.
 proc get_remotetimeout { } {
     global gdb_prompt
@@ -5645,6 +6124,19 @@ proc set_remotetimeout { timeout } {
     }
 }
 
+# Get the target's current endianness and return it.
+proc get_endianness { } {
+    global gdb_prompt
+
+    gdb_test_multiple "show endian" "determine endianness" {
+	-re ".* (little|big) endian.*\r\n$gdb_prompt $" {
+	    # Pass silently.
+	    return $expect_out(1,string)
+	}
+    }
+    return "little"
+}
+
 # ROOT and FULL are file names.  Returns the relative path from ROOT
 # to FULL.  Note that FULL must be in a subdirectory of ROOT.
 # For example, given ROOT = /usr/bin and FULL = /usr/bin/ls, this
@@ -5664,53 +6156,6 @@ proc relative_filename {root full} {
     return [eval file join [lrange $full_split $len end]]
 }
 
-# Log gdb command line and script if requested.
-if {[info exists TRANSCRIPT]} {
-  rename send_gdb real_send_gdb
-  rename remote_spawn real_remote_spawn
-  rename remote_close real_remote_close
-
-  global gdb_transcript
-  set gdb_transcript ""
-
-  global gdb_trans_count
-  set gdb_trans_count 1
-
-  proc remote_spawn {args} {
-    global gdb_transcript gdb_trans_count outdir
-
-    if {$gdb_transcript != ""} {
-      close $gdb_transcript
-    }
-    set gdb_transcript [open [file join $outdir transcript.$gdb_trans_count] w]
-    puts $gdb_transcript [lindex $args 1]
-    incr gdb_trans_count
-
-    return [uplevel real_remote_spawn $args]
-  }
-
-  proc remote_close {args} {
-    global gdb_transcript
-
-    if {$gdb_transcript != ""} {
-      close $gdb_transcript
-      set gdb_transcript ""
-    }
-
-    return [uplevel real_remote_close $args]
-  }
-
-  proc send_gdb {args} {
-    global gdb_transcript
-
-    if {$gdb_transcript != ""} {
-      puts -nonewline $gdb_transcript [lindex $args 0]
-    }
-
-    return [uplevel real_send_gdb $args]
-  }
-}
-
 # If GDB_PARALLEL exists, then set up the parallel-mode directories.
 if {[info exists GDB_PARALLEL]} {
     if {[is_remote host]} {
@@ -5795,39 +6240,84 @@ proc core_find {binfile {deletefiles {}} {arg ""}} {
 # for linker symbol prefixes.
 
 gdb_caching_proc gdb_target_symbol_prefix {
-    # Set up and compile a simple test program...
-    set src [standard_temp_file main[pid].c]
-    set exe [standard_temp_file main[pid].x]
+    # Compile a simple test program...
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile target_symbol_prefix $src executable]} {
+        return 0
+    }
 
-    gdb_produce_source $src {
-	int main() {
-	    return 0;
-	}
+    set prefix ""
+
+    set objdump_program [gdb_find_objdump]
+    set result [catch "exec $objdump_program --syms $obj" output]
+
+    if { $result == 0 \
+	&& ![regexp -lineanchor \
+	     { ([^ a-zA-Z0-9]*)main$} $output dummy prefix] } {
+	verbose "gdb_target_symbol_prefix: Could not find main in objdump output; returning null prefix" 2
     }
 
-    verbose "compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
+    file delete $obj
 
-    set prefix ""
+    return $prefix
+}
 
-    if ![string match "" $lines] then {
-        verbose "gdb_target_symbol_prefix: testfile compilation failed, returning null prefix" 2
-    } else {
-	set objdump_program [gdb_find_objdump]
-	set result [catch "exec $objdump_program --syms $exe" output]
+# Return 1 if target supports scheduler locking, otherwise return 0.
+
+gdb_caching_proc target_supports_scheduler_locking {
+    global gdb_prompt
+
+    set me "gdb_target_supports_scheduler_locking"
+
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile $me $src executable]} {
+        return 0
+    }
 
-	if { $result == 0 \
-	     && ![regexp -lineanchor \
-	          { ([^ a-zA-Z0-9]*)main$} $output dummy prefix] } {
-	    verbose "gdb_target_symbol_prefix: Could not find main in objdump output; returning null prefix" 2
+    clean_restart $obj
+    if ![runto_main] {
+        return 0
+    }
+
+    set supports_schedule_locking -1
+    set current_schedule_locking_mode ""
+
+    set test "reading current scheduler-locking mode"
+    gdb_test_multiple "show scheduler-locking" $test {
+	-re "Mode for locking scheduler during execution is \"(\[\^\"\]*)\".*$gdb_prompt" {
+	    set current_schedule_locking_mode $expect_out(1,string)
+	}
+	-re "$gdb_prompt $" {
+	    set supports_schedule_locking 0
+	}
+	timeout {
+	    set supports_schedule_locking 0
 	}
     }
 
-    file delete $src
-    file delete $exe
+    if { $supports_schedule_locking == -1 } {
+	set test "checking for scheduler-locking support"
+	gdb_test_multiple "set scheduler-locking $current_schedule_locking_mode" $test {
+	    -re "Target '\[^'\]+' cannot support this command\..*$gdb_prompt $" {
+		set supports_schedule_locking 0
+	    }
+	    -re "$gdb_prompt $" {
+		set supports_schedule_locking 1
+	    }
+	    timeout {
+		set supports_schedule_locking 0
+	    }
+	}
+    }
 
-    return $prefix
+    if { $supports_schedule_locking == -1 } {
+	set supports_schedule_locking 0
+    }
+
+    gdb_exit
+    remote_file build delete $obj
+    verbose "$me:  returning $supports_schedule_locking" 2
+    return $supports_schedule_locking
 }
 
 # gdb_target_symbol returns the provided symbol with the correct prefix
@@ -6017,6 +6507,231 @@ proc multi_line_input { args } {
     return [join $args "\n"]
 }
 
+# Return the version of the DejaGnu framework.
+#
+# The return value is a list containing the major, minor and patch version
+# numbers.  If the version does not contain a minor or patch number, they will
+# be set to 0.  For example:
+#
+#   1.6   -> {1 6 0}
+#   1.6.1 -> {1 6 1}
+#   2     -> {2 0 0}
+
+proc dejagnu_version { } {
+    # The frame_version variable is defined by DejaGnu, in runtest.exp.
+    global frame_version
+
+    verbose -log "DejaGnu version: $frame_version"
+    verbose -log "Expect version: [exp_version]"
+    verbose -log "Tcl version: [info tclversion]"
+
+    set dg_ver [split $frame_version .]
+
+    while { [llength $dg_ver] < 3 } {
+	lappend dg_ver 0
+    }
+
+    return $dg_ver
+}
+
+# Define user-defined command COMMAND using the COMMAND_LIST as the
+# command's definition.  The terminating "end" is added automatically.
+
+proc gdb_define_cmd {command command_list} {
+    global gdb_prompt
+
+    set input [multi_line_input {*}$command_list "end"]
+    set test "define $command"
+
+    gdb_test_multiple "define $command" $test {
+	-re "End with"  {
+	    gdb_test_multiple $input $test {
+		-re "\r\n$gdb_prompt " {
+		}
+	    }
+	}
+    }
+}
+
+# Override the 'cd' builtin with a version that ensures that the
+# log file keeps pointing at the same file.  We need this because
+# unfortunately the path to the log file is recorded using an
+# relative path name, and, we sometimes need to close/reopen the log
+# after changing the current directory.  See get_compiler_info.
+
+rename cd builtin_cd
+
+proc cd { dir } {
+
+    # Get the existing log file flags.
+    set log_file_info [log_file -info]
+
+    # Split the flags into args and file name.
+    set log_file_flags ""
+    set log_file_file ""
+    foreach arg [ split "$log_file_info" " "] {
+	if [string match "-*" $arg] {
+	    lappend log_file_flags $arg
+	} else {
+	    lappend log_file_file $arg
+	}
+    }
+
+    # If there was an existing file, ensure it is an absolute path, and then
+    # reset logging.
+    if { $log_file_file != "" } {
+	set log_file_file [file normalize $log_file_file]
+	log_file
+	log_file $log_file_flags "$log_file_file"
+    }
+
+    # Call the builtin version of cd.
+    builtin_cd $dir
+}
+
+# Return a list of all languages supported by GDB, suitable for use in
+# 'set language NAME'.  This doesn't include either the 'local' or
+# 'auto' keywords.
+proc gdb_supported_languages {} {
+    return [list c objective-c c++ d go fortran modula-2 asm pascal \
+		opencl rust minimal ada]
+}
+
+# Check if debugging is enabled for gdb.
+
+proc gdb_debug_enabled { } {
+    global gdbdebug
+
+    # If not already read, get the debug setting from environment or board setting.
+    if {![info exists gdbdebug]} {
+	global env
+	if [info exists env(GDB_DEBUG)] {
+	    set gdbdebug $env(GDB_DEBUG)
+	} elseif [target_info exists gdb,debug] {
+	    set gdbdebug [target_info gdb,debug]
+	} else {
+	    return 0
+	}
+    }
+
+    # Ensure it not empty.
+    return [expr { $gdbdebug != "" }]
+}
+
+# Turn on debugging if enabled, or reset if already on.
+
+proc gdb_debug_init { } {
+
+    global gdb_prompt
+
+    if ![gdb_debug_enabled] {
+      return;
+    }
+
+    # First ensure logging is off.
+    send_gdb "set logging off\n"
+
+    set debugfile [standard_output_file gdb.debug]
+    send_gdb "set logging file $debugfile\n"
+
+    send_gdb "set logging debugredirect\n"
+
+    global gdbdebug
+    foreach entry [split $gdbdebug ,] {
+      send_gdb "set debug $entry 1\n"
+    }
+
+    # Now that everything is set, enable logging.
+    send_gdb "set logging on\n"
+    gdb_expect 10 {
+	-re "Copying output to $debugfile.*Redirecting debug output to $debugfile.*$gdb_prompt $" {}
+	timeout { warning "Couldn't set logging file" }
+    }
+}
+
+# Check if debugging is enabled for gdbserver.
+
+proc gdbserver_debug_enabled { } {
+    # Always disabled for GDB only setups.
+    return 0
+}
+
+# Open the file for logging gdb input
+
+proc gdb_stdin_log_init { } {
+    global in_file
+
+    if {[info exists in_file]} {
+      # Close existing file.
+      catch "close $in_file"
+    }
+
+    set logfile [standard_output_file_with_gdb_instance gdb.in]
+    set in_file [open $logfile w]
+}
+
+# Write to the file for logging gdb input.
+# TYPE can be one of the following:
+# "standard" : Default. Standard message written to the log
+# "answer" : Answer to a question (eg "Y"). Not written the log.
+# "optional" : Optional message. Not written to the log.
+
+proc gdb_stdin_log_write { message {type standard} } {
+
+    global in_file
+    if {![info exists in_file]} {
+      return
+    }
+
+    # Check message types.
+    switch -regexp -- $type {
+        "answer" {
+            return
+        }
+        "optional" {
+            return
+        }
+    }
+
+    #Write to the log
+    puts -nonewline $in_file "$message"
+}
+
+# Write the command line used to invocate gdb to the cmd file.
+
+proc gdb_write_cmd_file { cmdline } {
+    set logfile [standard_output_file_with_gdb_instance gdb.cmd]
+    set cmd_file [open $logfile w]
+    puts $cmd_file $cmdline
+    catch "close $cmd_file"
+}
+
+# Compare contents of FILE to string STR.  Pass with MSG if equal, otherwise
+# fail with MSG.
+
+proc cmp_file_string { file str msg } {
+    if { ![file exists $file]} {
+	fail "$msg"
+	return
+    }
+
+    set caught_error [catch {
+	set fp [open "$file" r]
+	set file_contents [read $fp]
+	close $fp
+    } error_message]
+    if { $caught_error } then {
+	error "$error_message"
+	fail "$msg"
+	return
+    }
+
+    if { $file_contents == $str } {
+	pass "$msg"
+    } else {
+	fail "$msg"
+    }
+}
 
 # Always load compatibility stuff.
 load_lib future.exp