Mirror of the gdb-patches mailing list
 help / color / mirror / Atom feed
From: Tom Tromey <tromey@redhat.com>
To: gdb-patches@sourceware.org
Cc: Tom Tromey <tromey@redhat.com>
Subject: [PATCH 4/4] add caching procs to test suite
Date: Wed, 17 Jul 2013 14:59:00 -0000	[thread overview]
Message-ID: <1374073124-23602-5-git-send-email-tromey@redhat.com> (raw)
In-Reply-To: <1374073124-23602-1-git-send-email-tromey@redhat.com>

In the fully parallel mode, each .exp file can be run in parallel (at
least conceptually -- the actual split may not be so severe).  This
means that procs that compute a result and cache it are not going to
function very well.  The test they run will be invoked over and over.

This patch introduces a generic caching mechanism and changes these
procs to use it.

A caching proc is defined using gdb_caching_proc, which works like
"proc", except that it caches the result of the body.  In parallel
mode, the cache is kept on disk; it is cleared by the Makefile at the
start of a test run.

	* lib/cache.exp: New file.
	* lib/cell.exp (skip_cell_tests): Use gdb_caching_proc.
	* lib/gdb.exp: Load cache.exp.
	(support_complex_tests, is_ilp32_target, is_lp64_target)
	(is_amd64_regs_target, skip_altivec_tests, skip_vsx_tests)
	(gdb_skip_xml_test): Use gdb_caching_proc.
	* lib/opencl.exp (skip_opencl_tests): Use gdb_caching_proc.
---
 gdb/testsuite/lib/cache.exp  |  73 ++++++++++++++++++++++
 gdb/testsuite/lib/cell.exp   |  20 +++----
 gdb/testsuite/lib/gdb.exp    | 140 ++++++++++++++-----------------------------
 gdb/testsuite/lib/opencl.exp |  24 +++-----
 4 files changed, 133 insertions(+), 124 deletions(-)
 create mode 100644 gdb/testsuite/lib/cache.exp

diff --git a/gdb/testsuite/lib/cache.exp b/gdb/testsuite/lib/cache.exp
new file mode 100644
index 0000000..952f4ba
--- /dev/null
+++ b/gdb/testsuite/lib/cache.exp
@@ -0,0 +1,73 @@
+# Copyright 2012, 2013 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/>.
+
+
+# The in-memory cache.
+array set gdb_data_cache {}
+
+# A helper for gdb_caching_proc that handles the caching.
+
+proc gdb_do_cache {name} {
+    global gdb_data_cache objdir
+    global GDB_PARALLEL
+
+    if {[info exists gdb_data_cache($name)]} {
+	verbose "$name: returning '$gdb_data_cache($name)' from cache" 2
+	return $gdb_data_cache($name)
+    }
+
+    if {[info exists GDB_PARALLEL]} {
+	# See if some other process wrote the cache file.  Cache value
+	# per "board" to handle runs with multiple options
+	# (e.g. unix/{-m32,-64}) correctly.
+	set cache_filename [file join $objdir cache \
+				[target_info name] $name]
+	if {[file exists $cache_filename]} {
+	    set fd [open $cache_filename]
+	    set gdb_data_cache($name) [read -nonewline $fd]
+	    close $fd
+	    verbose "$name: returning '$gdb_data_cache($name)' from file cache" 2
+	    return $gdb_data_cache($name)
+	}
+    }
+
+    set real_name gdb_real__$name
+    set gdb_data_cache($name) [uplevel 1 $real_name]
+
+    if {[info exists GDB_PARALLEL]} {
+	verbose "$name: returning '$gdb_data_cache($name)' and writing file" 2
+	file mkdir [file dirname $cache_filename]
+	# Make sure to write the results file atomically.
+	set fd [open $cache_filename.[pid] w]
+	puts $fd $gdb_data_cache($name)
+	close $fd
+	file rename -force -- $cache_filename.[pid] $cache_filename
+    }
+    return $gdb_data_cache($name)
+}
+
+# Define a new proc named NAME that takes no arguments.  BODY is the
+# body of the proc.  The proc will evaluate BODY and cache the
+# results, both in memory and, if GDB_PARALLEL is defined, in the
+# filesystem for use across invocations of dejagnu.
+
+proc gdb_caching_proc {name body} {
+    # Define the underlying proc that we'll call.
+    set real_name gdb_real__$name
+    proc $real_name {} $body
+
+    # Define the advertised proc.
+    proc $name {} [list gdb_do_cache $name]
+}
diff --git a/gdb/testsuite/lib/cell.exp b/gdb/testsuite/lib/cell.exp
index e799b7f..9a20f5c 100644
--- a/gdb/testsuite/lib/cell.exp
+++ b/gdb/testsuite/lib/cell.exp
@@ -70,16 +70,10 @@ proc gdb_cell_embedspu {source dest options} {
 
 # Run a test on the target to see if it supports Cell/B.E. hardware.
 # Return 0 if so, 1 if it does not.
-proc skip_cell_tests {} {
-    global skip_cell_tests_saved
+gdb_caching_proc skip_cell_tests {
     global srcdir subdir gdb_prompt inferior_exited_re
 
-    # Use the cached value, if it exists.
     set me "skip_cell_tests"
-    if [info exists skip_cell_tests_saved] {
-        verbose "$me:  returning saved $skip_cell_tests_saved" 2
-        return $skip_cell_tests_saved
-    }
 
     # Set up, compile, and execute a combined Cell/B.E. test program.
     # Include the current process ID in the file names to prevent conflicts
@@ -125,7 +119,7 @@ proc skip_cell_tests {} {
     file delete $exe_spu-embed.o
 
     if { $skip } {
-        return [set skip_cell_tests_saved 1]
+        return 1
     }
 
     # Compilation succeeded so now run it via gdb.
@@ -138,22 +132,22 @@ proc skip_cell_tests {} {
     gdb_expect {
         -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
             verbose -log "\n$me: Cell/B.E. hardware detected"
-            set skip_cell_tests_saved 0
+            set result 0
         }
         -re ".*$inferior_exited_re with code.*${gdb_prompt} $" {
             verbose -log "\n$me: Cell/B.E. hardware not detected"
-            set skip_cell_tests_saved 1
+            set result 1
         }
         default {
             verbose -log "\n$me Cell/B.E. hardware not detected (default case)"
-            set skip_cell_tests_saved 1
+            set result 1
         }
     }
     gdb_exit
     remote_file build delete $exe
 
-    verbose "$me:  returning $skip_cell_tests_saved" 2
-    return $skip_cell_tests_saved
+    verbose "$me:  returning $result" 2
+    return $result
 }
 
 # Delete all breakpoints and stop on the next new SPU thread
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index a75ce35..fd37a81 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -26,6 +26,7 @@ if {$tool == ""} {
 }
 
 load_lib libgloss.exp
+load_lib cache.exp
 
 global GDB
 
@@ -1702,20 +1703,12 @@ proc with_test_prefix { prefix body } {
 
 # Return 1 if _Complex types are supported, otherwise, return 0.
 
-proc support_complex_tests {} {
-    global support_complex_tests_saved
-
-    # Use the cached value, if it exists.
-    if [info exists support_complex_tests_saved] {
-        verbose "returning saved $support_complex_tests_saved" 2
-        return $support_complex_tests_saved
-    }
-
+gdb_caching_proc support_complex_tests {
     # 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 complex[pid].c
-    set exe complex[pid].x
+    set src [standard_temp_file complex[pid].c]
+    set exe [standard_temp_file complex[pid].x]
 
     set f [open $src "w"]
     puts $f "int main() {"
@@ -1733,12 +1726,12 @@ proc support_complex_tests {} {
 
     if ![string match "" $lines] then {
         verbose "testfile compilation failed, returning 0" 2
-        set support_complex_tests_saved 0
+        set result 0
     } else {
-	set support_complex_tests_saved 1
+	set result 1
     }
 
-    return $support_complex_tests_saved
+    return $result
 }
 
 # Return 1 if target hardware or OS supports single stepping to signal
@@ -1791,21 +1784,11 @@ proc supports_reverse {} {
 # Return 1 if target is ILP32.
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
-proc is_ilp32_target {} {
-    global is_ilp32_target_saved
-
-    # Use the cached value, if it exists.  Cache value per "board" to handle
-    # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
+gdb_caching_proc is_ilp32_target {
     set me "is_ilp32_target"
-    set board [target_info name]
-    if [info exists is_ilp32_target_saved($board)] {
-        verbose "$me:  returning saved $is_ilp32_target_saved($board)" 2
-        return $is_ilp32_target_saved($board)
-    }
 
-
-    set src ilp32[pid].c
-    set obj ilp32[pid].o
+    set src [standard_temp_file ilp32[pid].c]
+    set obj [standard_temp_file ilp32[pid].o]
 
     set f [open $src "w"]
     puts $f "int dummy\[sizeof (int) == 4"
@@ -1820,30 +1803,21 @@ proc is_ilp32_target {} {
 
     if ![string match "" $lines] then {
         verbose "$me:  testfile compilation failed, returning 0" 2
-        return [set is_ilp32_target_saved($board) 0]
+        return 0
     }
 
     verbose "$me:  returning 1" 2
-    return [set is_ilp32_target_saved($board) 1]
+    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.
-proc is_lp64_target {} {
-    global is_lp64_target_saved
-
-    # Use the cached value, if it exists.  Cache value per "board" to handle
-    # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
+gdb_caching_proc is_lp64_target {
     set me "is_lp64_target"
-    set board [target_info name]
-    if [info exists is_lp64_target_saved($board)] {
-        verbose "$me:  returning saved $is_lp64_target_saved($board)" 2
-        return $is_lp64_target_saved($board)
-    }
 
-    set src lp64[pid].c
-    set obj lp64[pid].o
+    set src [standard_temp_file lp64[pid].c]
+    set obj [standard_temp_file lp64[pid].o]
 
     set f [open $src "w"]
     puts $f "int dummy\[sizeof (int) == 4"
@@ -1858,34 +1832,25 @@ proc is_lp64_target {} {
 
     if ![string match "" $lines] then {
         verbose "$me:  testfile compilation failed, returning 0" 2
-        return [set is_lp64_target_saved($board) 0]
+        return 0
     }
 
     verbose "$me:  returning 1" 2
-    return [set is_lp64_target_saved($board) 1]
+    return 1
 }
 
 # Return 1 if target has x86_64 registers - either amd64 or x32.
 # x32 target identifies as x86_64-*-linux*, therefore it cannot be determined
 # just from the target string.
-proc is_amd64_regs_target {} {
-    global is_amd64_regs_target_saved
-
+gdb_caching_proc is_amd64_regs_target {
     if {![istarget "x86_64-*-*"] && ![istarget "i?86-*"]} {
 	return 0
     }
 
-    # Use the cached value, if it exists.  Cache value per "board" to handle
-    # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
     set me "is_amd64_regs_target"
-    set board [target_info name]
-    if [info exists is_amd64_regs_target_saved($board)] {
-        verbose "$me:  returning saved $is_amd64_regs_target_saved($board)" 2
-        return $is_amd64_regs_target_saved($board)
-    }
 
-    set src reg64[pid].s
-    set obj reg64[pid].o
+    set src [standard_temp_file reg64[pid].s]
+    set obj [standard_temp_file reg64[pid].o]
 
     set f [open $src "w"]
     foreach reg \
@@ -1901,11 +1866,11 @@ proc is_amd64_regs_target {} {
 
     if ![string match "" $lines] then {
         verbose "$me:  testfile compilation failed, returning 0" 2
-        return [set is_amd64_regs_target_saved($board) 0]
+        return 0
     }
 
     verbose "$me:  returning 1" 2
-    return [set is_amd64_regs_target_saved($board) 1]
+    return 1
 }
 
 # Return 1 if this target is an x86 or x86-64 with -m32.
@@ -1932,20 +1897,14 @@ proc support_displaced_stepping {} {
 # 1 if it does not.  Based on 'check_vmx_hw_available' from the GCC testsuite.
 
 proc skip_altivec_tests {} {
-    global skip_vmx_tests_saved
     global srcdir subdir gdb_prompt inferior_exited_re
 
-    # Use the cached value, if it exists.
     set me "skip_altivec_tests"
-    if [info exists skip_vmx_tests_saved] {
-        verbose "$me:  returning saved $skip_vmx_tests_saved" 2
-        return $skip_vmx_tests_saved
-    }
 
     # Some simulators are known to not support VMX instructions.
     if { [istarget powerpc-*-eabi] || [istarget powerpc*-*-eabispe] } {
         verbose "$me:  target known to not support VMX, returning 1" 2
-        return [set skip_vmx_tests_saved 1]
+        return 1
     }
 
     # Make sure we have a compiler that understands altivec.
@@ -1966,8 +1925,8 @@ proc skip_altivec_tests {} {
     # 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 vmx[pid].c
-    set exe vmx[pid].x
+    set src [standard_temp_file vmx[pid].c]
+    set exe [standard_temp_file vmx[pid].x]
 
     set f [open $src "w"]
     puts $f "int main() {"
@@ -1985,7 +1944,7 @@ proc skip_altivec_tests {} {
 
     if ![string match "" $lines] then {
         verbose "$me:  testfile compilation failed, returning 1" 2
-        return [set skip_vmx_tests_saved 1]
+        return 1
     }
 
     # No error message, compilation succeeded so now run it via gdb.
@@ -1998,43 +1957,37 @@ proc skip_altivec_tests {} {
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
             verbose -log "\n$me altivec hardware not detected" 
-            set skip_vmx_tests_saved 1
+            set skip_vmx_tests 1
         }
         -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
             verbose -log "\n$me: altivec hardware detected" 
-            set skip_vmx_tests_saved 0
+            set skip_vmx_tests 0
         }
         default {
           warning "\n$me: default case taken"
-            set skip_vmx_tests_saved 1
+            set skip_vmx_tests 1
         }
     }
     gdb_exit
     remote_file build delete $exe
 
-    verbose "$me:  returning $skip_vmx_tests_saved" 2
-    return $skip_vmx_tests_saved
+    verbose "$me:  returning $skip_vmx_tests" 2
+    return $skip_vmx_tests
 }
 
 # Run a test on the target to see if it supports vmx hardware.  Return 0 if so,
 # 1 if it does not.  Based on 'check_vmx_hw_available' from the GCC testsuite.
 
 proc skip_vsx_tests {} {
-    global skip_vsx_tests_saved
     global srcdir subdir gdb_prompt inferior_exited_re
 
-    # Use the cached value, if it exists.
     set me "skip_vsx_tests"
-    if [info exists skip_vsx_tests_saved] {
-        verbose "$me:  returning saved $skip_vsx_tests_saved" 2
-        return $skip_vsx_tests_saved
-    }
 
     # Some simulators are known to not support Altivec instructions, so
     # they won't support VSX instructions as well.
     if { [istarget powerpc-*-eabi] || [istarget powerpc*-*-eabispe] } {
         verbose "$me:  target known to not support VSX, returning 1" 2
-        return [set skip_vsx_tests_saved 1]
+        return 1
     }
 
     # Make sure we have a compiler that understands altivec.
@@ -2052,8 +2005,8 @@ proc skip_vsx_tests {} {
         return 1
     }
 
-    set src vsx[pid].c
-    set exe vsx[pid].x
+    set src [standard_temp_file vsx[pid].c]
+    set exe [standard_temp_file vsx[pid].x]
 
     set f [open $src "w"]
     puts $f "int main() {"
@@ -2072,7 +2025,7 @@ proc skip_vsx_tests {} {
 
     if ![string match "" $lines] then {
         verbose "$me:  testfile compilation failed, returning 1" 2
-        return [set skip_vsx_tests_saved 1]
+        return 1
     }
 
     # No error message, compilation succeeded so now run it via gdb.
@@ -2085,22 +2038,22 @@ proc skip_vsx_tests {} {
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
             verbose -log "\n$me VSX hardware not detected"
-            set skip_vsx_tests_saved 1
+            set skip_vsx_tests 1
         }
         -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
             verbose -log "\n$me: VSX hardware detected"
-            set skip_vsx_tests_saved 0
+            set skip_vsx_tests 0
         }
         default {
           warning "\n$me: default case taken"
-            set skip_vsx_tests_saved 1
+            set skip_vsx_tests 1
         }
     }
     gdb_exit
     remote_file build delete $exe
 
-    verbose "$me:  returning $skip_vsx_tests_saved" 2
-    return $skip_vsx_tests_saved
+    verbose "$me:  returning $skip_vsx_tests" 2
+    return $skip_vsx_tests
 }
 
 # Run a test on the target to see if it supports btrace hardware.  Return 0 if so,
@@ -3856,25 +3809,20 @@ proc gdb_skip_bogus_test { msg } {
 # in the host GDB.
 # NOTE: This must be called while gdb is *not* running.
 
-proc gdb_skip_xml_test { } {
+gdb_caching_proc gdb_skip_xml_test {
     global gdb_prompt
     global srcdir
-    global xml_missing_cached
-
-    if {[info exists xml_missing_cached]} {
-	return $xml_missing_cached
-    }
 
     gdb_start
-    set xml_missing_cached 0
+    set xml_missing 0
     gdb_test_multiple "set tdesc filename ${srcdir}/gdb.xml/trivial.xml" "" {
 	-re ".*XML support was disabled at compile time.*$gdb_prompt $" {
-	    set xml_missing_cached 1
+	    set xml_missing 1
 	}
 	-re ".*$gdb_prompt $" { }
     }
     gdb_exit
-    return $xml_missing_cached
+    return $xml_missing
 }
 
 # Note: the procedure gdb_gnu_strip_debug will produce an executable called
diff --git a/gdb/testsuite/lib/opencl.exp b/gdb/testsuite/lib/opencl.exp
index 5afb3f8..3249139 100644
--- a/gdb/testsuite/lib/opencl.exp
+++ b/gdb/testsuite/lib/opencl.exp
@@ -29,18 +29,11 @@ proc gdb_compile_opencl_hostapp {clsource executable options} {
 
 # Run a test on the target to check if it supports OpenCL. Return 0 if so, 1 if
 # it does not.
-proc skip_opencl_tests {} {
-    global skip_opencl_tests_saved srcdir objdir subdir gdb_prompt
+gdb_caching_proc skip_opencl_tests {
+    global srcdir objdir subdir gdb_prompt
     global inferior_exited_re
 
-    # Use the cached value, if it exists.  Cache value per "board" to handle
-    # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
     set me "skip_opencl_tests"
-    set board [target_info name]
-    if [info exists skip_opencl_tests_saved($board)] {
-        verbose "$me:  returning saved $skip_opencl_tests_saved($board)" 2
-        return $skip_opencl_tests_saved($board)
-    }
 
     # Set up, compile, and execute an OpenCL program.  Include the current
     # process ID in the file name of the executable to prevent conflicts with
@@ -52,8 +45,9 @@ proc skip_opencl_tests {} {
     set compile_flags {debug nowarnings quiet}
 
     if { [gdb_compile_opencl_hostapp "${clprogram}" "${executable}" "${compile_flags}" ] != "" } {
+	remote_file target delete ${clprogram}
         verbose "$me:  compiling OpenCL binary failed, returning 1" 2
-	return [set skip_opencl_tests_saved($board) 1]
+	return 1
     }
 
     # Compilation succeeded so now run it via gdb.
@@ -62,15 +56,15 @@ proc skip_opencl_tests {} {
     gdb_expect 30 {
         -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
             verbose -log "\n$me: OpenCL support detected"
-            set skip_opencl_tests_saved($board) 0
+            set result 0
         }
         -re ".*$inferior_exited_re code.*${gdb_prompt} $" {
             verbose -log "\n$me: OpenCL support not detected"
-            set skip_opencl_tests_saved($board) 1
+            set result 1
         }
         default {
             verbose -log "\n$me OpenCL support not detected (default case)"
-            set skip_opencl_tests_saved($board) 1
+            set result 1
         }
     }
     gdb_exit
@@ -79,6 +73,6 @@ proc skip_opencl_tests {} {
     # Delete the OpenCL program source file.
     remote_file target delete ${clprogram}
 
-    verbose "$me:  returning $skip_opencl_tests_saved($board)" 2
-    return $skip_opencl_tests_saved($board)
+    verbose "$me:  returning $result" 2
+    return $result
 }
-- 
1.8.1.4


  parent reply	other threads:[~2013-07-17 14:59 UTC|newest]

Thread overview: 18+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-07-17 14:58 [PATCH 0/4] introduce test suite "parallel" mode Tom Tromey
2013-07-17 14:59 ` [PATCH 3/4] add standard_temp_file Tom Tromey
2013-07-17 14:59 ` [PATCH 2/4] introduce parallel mode Tom Tromey
2013-07-18 12:42   ` Yao Qi
2013-07-18 13:36     ` Tom Tromey
2013-07-18 22:22       ` Yao Qi
2013-08-01 19:45         ` Tom Tromey
2013-08-01 20:58           ` Tom Tromey
2013-08-02  6:23           ` Yao Qi
2013-08-02  8:41           ` Pedro Alves
2013-08-02 15:02             ` Tom Tromey
2013-08-01 16:56   ` Pedro Alves
2013-07-17 14:59 ` [PATCH 1/4] more uses of standard_output_file Tom Tromey
2013-07-17 14:59 ` Tom Tromey [this message]
2013-08-01 17:10   ` [PATCH 4/4] add caching procs to test suite Pedro Alves
2013-08-01 17:58     ` Tom Tromey
2013-08-01 17:14 ` [PATCH 0/4] introduce test suite "parallel" mode Pedro Alves
2013-08-01 19:22   ` Tom Tromey

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1374073124-23602-5-git-send-email-tromey@redhat.com \
    --to=tromey@redhat.com \
    --cc=gdb-patches@sourceware.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox