GDB 7.6.50

gdb/testsuite/lib/perftest.exp

Index: gdb/testsuite/lib/perftest.exp
diff --git a/gdb/testsuite/lib/perftest.exp b/gdb/testsuite/lib/perftest.exp
new file mode 100644
index 0000000000000000000000000000000000000000..3822207a67b040a93837795eca0d506a8fbb447c
--- /dev/null
+++ b/gdb/testsuite/lib/perftest.exp
@@ -0,0 +1,125 @@
+# Copyright (C) 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/>.
+
+namespace eval PerfTest {
+    # The name of python file on build.
+    variable remote_python_file
+
+    # A private method to set up GDB for performance testing.
+    proc _setup_perftest {} {
+	variable remote_python_file
+	global srcdir subdir testfile
+
+	set remote_python_file [gdb_remote_download host ${srcdir}/${subdir}/${testfile}.py]
+
+	# Set sys.path for module perftest.
+	gdb_test_no_output "python import os, sys"
+	gdb_test_no_output "python sys.path.insert\(0, os.path.abspath\(\"${srcdir}/${subdir}/lib\"\)\)"
+	gdb_test_no_output "python exec (open ('${remote_python_file}').read ())"
+    }
+
+    # A private method to do some cleanups when performance test is
+    # finished.
+    proc _teardown_perftest {} {
+	variable remote_python_file
+
+	remote_file host delete $remote_python_file
+    }
+
+    # Compile source files of test case.  BODY is the tcl code to do
+    # actual compilation.  Return zero if compilation is successful,
+    # otherwise return non-zero.
+    proc compile {body} {
+	global GDB_PERFTEST_MODE
+
+	if { [info exists GDB_PERFTEST_MODE]
+	     && [string compare $GDB_PERFTEST_MODE "run"] } {
+	    return [uplevel 2 $body]
+	}
+
+	return 0
+    }
+
+    # Start up GDB.
+    proc startup_gdb {body} {
+	uplevel 2 $body
+    }
+
+    # Run the performance test.
+    proc run {body} {
+	global timeout
+	global GDB_PERFTEST_TIMEOUT
+
+	set oldtimeout $timeout
+	if { [info exists GDB_PERFTEST_TIMEOUT] } {
+	    set timeout $GDB_PERFTEST_TIMEOUT
+	} else {
+	    set timeout 3000
+	}
+	uplevel 2 $body
+
+	set timeout $oldtimeout
+    }
+
+    # The top-level interface to PerfTest.
+    # COMPILE is the tcl code to generate and compile source files.
+    # Return zero if compilation is successful,  otherwise return
+    # non-zero.
+    # STARTUP is the tcl code to start up GDB.
+    # RUN is the tcl code to drive GDB to do some operations.
+    proc assemble {compile startup run} {
+	global GDB_PERFTEST_MODE
+
+	if { [eval compile {$compile}] } {
+	    untested "Could not compile source files."
+	    return
+	}
+
+	# Don't execute the run if GDB_PERFTEST_MODE=compile.
+	if { [info exists GDB_PERFTEST_MODE]
+	     && [string compare $GDB_PERFTEST_MODE "compile"] == 0} {
+	    return
+	}
+
+	eval $startup
+
+	_setup_perftest
+
+	eval run {$run}
+
+	_teardown_perftest
+    }
+}
+
+# Return true if performance tests are skipped.
+
+proc skip_perf_tests { } {
+    global GDB_PERFTEST_MODE
+
+    if [info exists GDB_PERFTEST_MODE] {
+
+	if { "$GDB_PERFTEST_MODE" != "compile"
+	     && "$GDB_PERFTEST_MODE" != "run"
+	     && "$GDB_PERFTEST_MODE" != "both" } {
+	    # GDB_PERFTEST_MODE=compile|run|both is allowed.
+	    error "Unknown value of GDB_PERFTEST_MODE."
+	    return 1
+	}
+
+	return 0
+    }
+
+    return 1
+}