GDB 7.6.50

gdb/testsuite/lib/perftest.exp

+# 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
+}