perftest.exp revision 1.5
1# Copyright (C) 2013-2015 Free Software Foundation, Inc. 2 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 3 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16namespace eval PerfTest { 17 # The name of python file on build. 18 variable remote_python_file 19 20 # A private method to set up GDB for performance testing. 21 proc _setup_perftest {} { 22 variable remote_python_file 23 global srcdir subdir testfile 24 25 set remote_python_file [gdb_remote_download host ${srcdir}/${subdir}/${testfile}.py] 26 27 # Set sys.path for module perftest. 28 gdb_test_no_output "python import os, sys" 29 gdb_test_no_output "python sys.path.insert\(0, os.path.abspath\(\"${srcdir}/${subdir}/lib\"\)\)" 30 gdb_test_no_output "python exec (open ('${remote_python_file}').read ())" 31 } 32 33 # A private method to do some cleanups when performance test is 34 # finished. 35 proc _teardown_perftest {} { 36 variable remote_python_file 37 38 remote_file host delete $remote_python_file 39 } 40 41 # Compile source files of test case. BODY is the tcl code to do 42 # actual compilation. Return zero if compilation is successful, 43 # otherwise return non-zero. 44 proc compile {body} { 45 global GDB_PERFTEST_MODE 46 47 if { [info exists GDB_PERFTEST_MODE] 48 && [string compare $GDB_PERFTEST_MODE "run"] } { 49 return [uplevel 2 $body] 50 } 51 52 return 0 53 } 54 55 # Start up GDB. 56 proc startup_gdb {body} { 57 uplevel 2 $body 58 } 59 60 # Run the performance test. 61 proc run {body} { 62 global timeout 63 global GDB_PERFTEST_TIMEOUT 64 65 set oldtimeout $timeout 66 if { [info exists GDB_PERFTEST_TIMEOUT] } { 67 set timeout $GDB_PERFTEST_TIMEOUT 68 } else { 69 set timeout 3000 70 } 71 uplevel 2 $body 72 73 set timeout $oldtimeout 74 } 75 76 # The top-level interface to PerfTest. 77 # COMPILE is the tcl code to generate and compile source files. 78 # Return zero if compilation is successful, otherwise return 79 # non-zero. 80 # STARTUP is the tcl code to start up GDB. 81 # RUN is the tcl code to drive GDB to do some operations. 82 proc assemble {compile startup run} { 83 global GDB_PERFTEST_MODE 84 85 if { [eval compile {$compile}] } { 86 untested "Could not compile source files." 87 return 88 } 89 90 # Don't execute the run if GDB_PERFTEST_MODE=compile. 91 if { [info exists GDB_PERFTEST_MODE] 92 && [string compare $GDB_PERFTEST_MODE "compile"] == 0} { 93 return 94 } 95 96 eval $startup 97 98 _setup_perftest 99 100 eval run {$run} 101 102 _teardown_perftest 103 } 104} 105 106# Return true if performance tests are skipped. 107 108proc skip_perf_tests { } { 109 global GDB_PERFTEST_MODE 110 111 if [info exists GDB_PERFTEST_MODE] { 112 113 if { "$GDB_PERFTEST_MODE" != "compile" 114 && "$GDB_PERFTEST_MODE" != "run" 115 && "$GDB_PERFTEST_MODE" != "both" } { 116 # GDB_PERFTEST_MODE=compile|run|both is allowed. 117 error "Unknown value of GDB_PERFTEST_MODE." 118 return 1 119 } 120 121 return 0 122 } 123 124 return 1 125} 126