gdb/testsuite/lib/perftest.exp

   1 # Copyright (C) 2013-2014 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
  16 namespace 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
 108 proc 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 }