[binutils-gdb] gdb/testsuite: add a debuginfod-support.exp helper library

[Andrew Burgess <aburgess@sourceware.org>]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=430676bc51fb5278e89fd9ef84ac9e7ab71f46c5

commit 430676bc51fb5278e89fd9ef84ac9e7ab71f46c5
Author: Andrew Burgess <aburgess@redhat.com>
Date:   Wed Sep 7 12:34:00 2022 +0100

    gdb/testsuite: add a debuginfod-support.exp helper library
    
    We currently have a single test for GDB's debuginfod support, this is
    gdb.debuginfod/fetch_src_and_symbols.exp, this script does all the
    setup, starts debuginfod, and then does the testing.
    
    This commit tries to split the existing script in two, there is a new
    library lib/debuginfod-support.exp, which contains a helper functions
    related to running debuginfod tests.  All the code in the new library
    is basically copied from the existing test case (which is why I
    retained the copyright date range on the new library), with some minor
    adjustments to try and make the code a little more generic.
    
    One change I made, for example, is the library offers functions to
    shut down debuginfod, previously we just relied on expect shutting
    down debuginfod when dejagnu completed.
    
    The existing test script is updated to make use of the new library
    code, and this test is still passing for me.  The only change in the
    test results is a single test where I changed the name to remove the
    port number from the test name - the port number can change from run
    to run, so could make it hard to compare test results.
    
    I have also done a little light house keeping on the original test
    script, updating and adding new comments, and making use of
    proc_with_prefix in a couple of places.

Diff:
---
 .../gdb.debuginfod/fetch_src_and_symbols.exp       | 158 +++++------------
 gdb/testsuite/lib/debuginfod-support.exp           | 196 +++++++++++++++++++++
 2 files changed, 243 insertions(+), 111 deletions(-)

diff --git a/gdb/testsuite/gdb.debuginfod/fetch_src_and_symbols.exp b/gdb/testsuite/gdb.debuginfod/fetch_src_and_symbols.exp
index 74d026464b9..d781d7a53c7 100644
--- a/gdb/testsuite/gdb.debuginfod/fetch_src_and_symbols.exp
+++ b/gdb/testsuite/gdb.debuginfod/fetch_src_and_symbols.exp
@@ -18,35 +18,9 @@
 standard_testfile main.c
 
 load_lib dwarf.exp
+load_lib debuginfod-support.exp
 
-if { [which debuginfod] == 0 } {
-    untested "cannot find debuginfod"
-    return -1
-}
-
-if { [which curl] == 0 } {
-    untested "cannot find curl"
-    return -1
-}
-
-# Skip testing if gdb was not configured with debuginfod
-#
-# If GDB is built with ASan, it warns that some signal handlers (installed by
-# ASan) exist on startup.  That makes TCL's exec throw an error.  Disable that
-# by passing --quiet.
-
-if { [string first "with-debuginfod" \
-	 [eval exec $GDB --quiet $INTERNAL_GDBFLAGS --configuration]] == -1 } {
-    untested "gdb not configured with debuginfod"
-    return -1
-}
-
-set cache [standard_output_file ".client_cache"]
-set db [standard_output_file ".debuginfod.db"]
-
-# Delete any preexisting test files
-file delete -force $cache
-file delete -force $db
+if { [skip_debuginfod_tests] } { return -1 }
 
 set sourcetmp [standard_output_file tmp-${srcfile}]
 set outputdir [standard_output_file {}]
@@ -121,19 +95,25 @@ proc write_dwarf_file {filename buildid {value 99}} {
 
 set corefile [standard_output_file "corefile"]
 
-proc no_url { } {
+# Setup the global variable DEBUGDIR as a directory containing the
+# debug information for the test executable.
+#
+# Run some tests to confirm that GDB is not able to find any of the
+# debug information from DEBUGDIR when the debuginfod server is not
+# running.
+proc_with_prefix no_url { } {
     global binfile outputdir debugdir
 
     setenv DEBUGINFOD_URLS ""
 
-    # Test that gdb cannot find source without debuginfod
+    # Test that GDB cannot find source without debuginfod.
     clean_restart $binfile
     gdb_test_no_output "set substitute-path $outputdir /dev/null" \
 	"set substitute-path"
     gdb_test "list" ".*No such file or directory.*"
 
-    # Strip symbols into separate file and move it so gdb cannot find it \
-	without debuginfod
+    # Strip symbols into separate file and move it so GDB cannot find it
+    # without debuginfod.
     if { [gdb_gnu_strip_debug $binfile ""] != 0 } {
 	fail "strip debuginfo"
 	return -1
@@ -145,7 +125,7 @@ proc no_url { } {
     file mkdir $debugdir
     file rename -force $debuginfo $debugdir
 
-    # Test that gdb cannot find symbols without debuginfod
+    # Test that GDB cannot find symbols without debuginfod.
     clean_restart $binfile
     gdb_test "file" ".*No symbol file.*"
 
@@ -169,13 +149,14 @@ proc no_url { } {
 
     file rename -force ${binfile}_dwz.o $debugdir
 
-    # Test that gdb cannot find dwz without debuginfod.
+    # Test that GDB cannot find dwz without debuginfod.
     clean_restart
     gdb_test "file ${binfile}_alt.o" \
 	".*could not find '.gnu_debugaltlink'.*" \
 	"file [file tail ${binfile}_alt.o]"
 
-    # Generate a core file and test that gdb cannot find the executable
+    # Generate a core file and test that GDB cannot find the
+    # executable.
     clean_restart ${binfile}2
     gdb_test "start" "Temporary breakpoint.*"
     gdb_test "generate-core-file $::corefile" "Saved corefile $::corefile" \
@@ -208,64 +189,24 @@ proc test_urls {urls pattern_re test} {
 	$test
 }
 
-proc local_url { } {
-    global binfile outputdir db debugdir
-
-    # Find an unused port
-    set port 7999
-    set found 0
-    while { ! $found } {
-	incr port
-	if { $port == 65536 } {
-	    fail "no available ports"
-	    return -1
-	}
-
-	spawn debuginfod -vvvv -d $db -p $port -F $debugdir
-	expect {
-	    "started http server on IPv4 IPv6 port=$port" { set found 1 }
-	    "started http server on IPv4 port=$port" { set found 1 }
-	    "started http server on IPv6 port=$port" {}
-	    "failed to bind to port" {}
-	    timeout {
-		fail "find port timeout"
-		return -1
-	    }
-	}
-	if { ! $found } {
-	    kill_wait_spawned_process $spawn_id
-	}
-    }
-
-    set metrics [list "ready 1" \
-		     "thread_work_total{role=\"traverse\"} 1" \
-		     "thread_work_pending{role=\"scan\"} 0" \
-		     "thread_busy{role=\"scan\"} 0"]
-
-    # Check server metrics to confirm init has completed.
-    foreach m $metrics {
-	set timelim 20
-	while { $timelim != 0 } {
-	    sleep 0.5
-	    catch {exec curl -s http://127.0.0.1:$port/metrics} got
-
-	    if { [regexp $m $got] } {
-		break
-	    }
-
-	    incr timelim -1
-	}
-
-	if { $timelim == 0 } {
-	    fail "server init timeout"
-	    return -1
-	}
+# Uses the global variables DEBUGDIR and DB which are setup elsewhere
+# in this script.
+#
+# Start debuginfod server, and confirm that GDB can now find all the
+# expected debug information.
+proc_with_prefix local_url { } {
+    global binfile outputdir debugdir db
+
+    set url [start_debuginfod $db $debugdir]
+    if { $url == "" } {
+	unresolved "failed to start debuginfod server"
+	return
     }
 
-    # Point the client to the server
-    setenv DEBUGINFOD_URLS http://127.0.0.1:$port
+    # Point the client to the server.
+    setenv DEBUGINFOD_URLS $url
 
-    # gdb should now find the symbol and source files
+    # GDB should now find the symbol and source files.
     clean_restart
     gdb_test "file $binfile" "" "file [file tail $binfile]" "Enable debuginfod?.*" "y"
     gdb_test_no_output "set substitute-path $outputdir /dev/null" \
@@ -273,31 +214,33 @@ proc local_url { } {
     gdb_test "br main" "Breakpoint 1 at.*file.*"
     gdb_test "l" ".*This program is distributed in the hope.*"
 
-    # gdb should now find the executable file
+    # GDB should now find the executable file.
     clean_restart
     gdb_test "core $::corefile" ".*return 0.*" "file [file tail $::corefile]" \
 	"Enable debuginfod?.*" "y"
 
-    # gdb should now find the debugaltlink file
+    # GDB should now find the debugaltlink file.
     clean_restart
     gdb_test "file ${binfile}_alt.o" \
 	".*Downloading.*separate debug info.*" \
 	"file [file tail ${binfile}_alt.o]" \
 	".*Enable debuginfod?.*" "y"
 
-    # Configure debuginfod with commands
+    # Configure debuginfod with commands.
     unsetenv DEBUGINFOD_URLS
     clean_restart
     gdb_test "file $binfile" ".*No debugging symbols.*" \
 	"file [file tail $binfile] cmd"
     gdb_test_no_output "set debuginfod enabled off"
-    gdb_test_no_output "set debuginfod urls http://127.0.0.1:$port"
+    gdb_test_no_output "set debuginfod urls $url" \
+	"set debuginfod url environment variable"
 
-    # gdb shouldn't find the debuginfo since debuginfod has been disabled
+    # GDB shouldn't find the debuginfo since debuginfod has been
+    # disabled.
     gdb_test "file $binfile" ".*No debugging symbols.*" \
 	"file [file tail $binfile] cmd off"
 
-    # Enable debuginfod and fetch the debuginfo
+    # Enable debuginfod and fetch the debuginfo.
     gdb_test_no_output "set debuginfod enabled on"
     gdb_test "file $binfile" ".*Reading symbols from.*debuginfo.*" \
 	"file [file tail $binfile] cmd on"
@@ -331,8 +274,6 @@ proc local_url { } {
 	}
     }
 
-    set url "http://127.0.0.1:$port"
-
     test_urls $url \
 	"<$url>" \
 	"notice 1 URL"
@@ -341,7 +282,7 @@ proc local_url { } {
 	"<$url>" \
 	"notice 1 URL with whitespace"
 
-    set url2 "127.0.0.1:$port"
+    set url2 [regsub "^http://" $url ""]
 
     test_urls "$url $url2" \
 	"<$url>\r\n +<$url2>" \
@@ -352,17 +293,12 @@ proc local_url { } {
 	"notice 2 URLs with whitespace"
 }
 
-set envlist \
-    [list \
-	 env(DEBUGINFOD_URLS) \
-	 env(DEBUGINFOD_TIMEOUT) \
-	 env(DEBUGINFOD_CACHE_PATH)]
-
-save_vars $envlist {
-    setenv DEBUGINFOD_TIMEOUT 30
-    setenv DEBUGINFOD_CACHE_PATH $cache
+# Create CACHE and DB directories ready for debuginfod to use.
+prepare_for_debuginfod cache db
 
-    with_test_prefix no_url no_url
-
-    with_test_prefix local_url local_url
+with_debuginfod_env $cache {
+    no_url
+    local_url
 }
+
+stop_debuginfod
diff --git a/gdb/testsuite/lib/debuginfod-support.exp b/gdb/testsuite/lib/debuginfod-support.exp
new file mode 100644
index 00000000000..ceecf907111
--- /dev/null
+++ b/gdb/testsuite/lib/debuginfod-support.exp
@@ -0,0 +1,196 @@
+# Copyright 2020-2022 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/>.
+
+# Helper functions to make it easier to write debuginfod tests.
+
+# Return true if the debuginfod tests should be skipped, otherwise, return
+# false.
+proc skip_debuginfod_tests {} {
+    if [is_remote host] {
+	return true
+    }
+
+    if { [which debuginfod] == 0 } {
+	return true
+    }
+
+    if { [which curl] == 0 } {
+	untested "cannot find curl"
+	return true
+    }
+
+    # Skip testing if gdb was not configured with debuginfod.
+    #
+    # If GDB is built with ASan, it warns that some signal handlers
+    # (installed by ASan) exist on startup.  That makes TCL's exec throw an
+    # error.  Disable that by passing --quiet.
+    if { [string first "with-debuginfod" \
+	      [eval exec $::GDB --quiet $::INTERNAL_GDBFLAGS \
+		   --configuration]] == -1 } {
+	return true
+    }
+
+    return false
+}
+
+# Create two directories within the current output directory.  One directory
+# will be used by GDB as the client cache to hold downloaded debug
+# information, and the other directory will be used by the debuginfod server
+# as its cache of the parsed debug files that will be served to GDB.
+#
+# Call this proc with the names to two variables, these variables will be
+# set in the parent scope with the paths to the two directories.
+#
+# This proc allocates the names for the directories, but doesn't create
+# them.  In fact, if the directories already exist, this proc will delete
+# them, this ensures that any existing contents are also deleted.
+proc prepare_for_debuginfod { cache_var db_var } {
+    upvar $cache_var cache
+    upvar $db_var db
+
+    set cache [standard_output_file ".client_cache"]
+    set db [standard_output_file ".debuginfod.db"]
+
+    # Delete any preexisting test files.
+    file delete -force $cache
+    file delete -force $db
+}
+
+# Run BODY with the three environment variables required to control
+# debuginfod set.  The timeout is set based on the usual timeouts used by
+# GDB within dejagnu (see get_largest_timeout), the debuginfod cache is set
+# to CACHE (this is where downloaded debug data is placed), and the
+# debuginfod urls environment variable is set to be the empty string.
+#
+# Within BODY you should start a debuginfod server and set the environment
+# variable DEBUGINFOD_URLS as appropriate (see start_debuginfod for details).
+#
+# The reason that this proc doesn't automatically start debuginfod, is that
+# in some test cases we want to initially test with debuginfod not running
+# and/or disabled.
+proc with_debuginfod_env { cache body } {
+    set envlist \
+	[list \
+	     env(DEBUGINFOD_URLS) \
+	     env(DEBUGINFOD_TIMEOUT) \
+	     env(DEBUGINFOD_CACHE_PATH)]
+
+    save_vars $envlist {
+	setenv DEBUGINFOD_TIMEOUT [get_largest_timeout]
+	setenv DEBUGINFOD_CACHE_PATH $cache
+	setenv DEBUGINFOD_URLS ""
+
+	uplevel 1 $body
+    }
+}
+
+# Start a debuginfod server.  DB is the directory to use for the server's
+# database cache, while DEBUGDIR is a directory containing all the debug
+# information that the server should server.
+#
+# This proc will try to find an available port to start the server on, will
+# start the server, and check that the server has started correctly.
+#
+# If the server starts correctly, then this proc will return the url that
+# should be used to communicate with the server.  If the server can't be
+# started, then an error will be printed, and an empty string returned.
+#
+# If the server is successfully started then the global variable
+# debuginfod_spawn_id will be set with the spawn_id of the debuginfod
+# process.
+proc start_debuginfod { db debugdir } {
+    global debuginfod_spawn_id spawn_id
+
+    # Find an unused port.
+    set port 7999
+    set found false
+    while { ! $found } {
+	incr port
+	if { $port == 65536 } {
+	    perror "no available ports"
+	    return ""
+	}
+
+	if { [info exists spawn_id] } {
+	    set old_spawn_id $spawn_id
+	}
+
+	spawn debuginfod -vvvv -d $db -p $port -F $debugdir
+	set debuginfod_spawn_id $spawn_id
+
+	if { [info exists old_spawn_id] } {
+	    set spawn_id $old_spawn_id
+	    unset old_spawn_id
+	}
+
+	expect {
+	    -i $debuginfod_spawn_id
+	    "started http server on IPv4 IPv6 port=$port" { set found true }
+	    "started http server on IPv4 port=$port" { set found true }
+	    "started http server on IPv6 port=$port" {}
+	    "failed to bind to port" {}
+	    timeout {
+		stop_debuginfod
+		perror "find port timeout"
+		return ""
+	    }
+	}
+	if { ! $found } {
+	    stop_debuginfod
+	}
+    }
+
+    set url "http://127.0.0.1:$port"
+
+    set metrics [list "ready 1" \
+		     "thread_work_total{role=\"traverse\"} 1" \
+		     "thread_work_pending{role=\"scan\"} 0" \
+		     "thread_busy{role=\"scan\"} 0"]
+
+    # Check server metrics to confirm init has completed.
+    foreach m $metrics {
+	set timelim 20
+	while { $timelim != 0 } {
+	    sleep 0.5
+	    catch {exec curl -s $url/metrics} got
+
+	    if { [regexp $m $got] } {
+		break
+	    }
+
+	    incr timelim -1
+	}
+
+	if { $timelim == 0 } {
+	    stop_debuginfod
+	    perror "server init timeout"
+	    return ""
+	}
+    }
+
+    return $url
+}
+
+# If the global debuginfod_spawn_id exists, then kill that process and unset
+# the debuginfod_spawn_id global.  This can be used to shutdown the
+# debuginfod server.
+proc stop_debuginfod { } {
+    global debuginfod_spawn_id
+
+    if [info exists debuginfod_spawn_id] {
+	kill_wait_spawned_process $debuginfod_spawn_id
+	unset debuginfod_spawn_id
+    }
+}