# Copyright (C) 2013-2015 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 . 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 }