gdb/testsuite/lib/perftest.exp

   1 # Copyright (C) 2013-2020 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         return [uplevel 2 $body]
  46     }
  47
  48     # Run the startup code.  Return zero if startup is successful,
  49     # otherwise return non-zero.
  50     proc startup {body} {
  51         return [uplevel 2 $body]
  52     }
  53
  54     # Start up GDB.
  55     proc startup_gdb {body} {
  56         uplevel 2 $body
  57     }
  58
  59     # Run the performance test.  Return zero if the run is successful,
  60     # otherwise return non-zero.
  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         set result [uplevel 2 $body]
  72
  73         set timeout $oldtimeout
  74         return $result
  75     }
  76
  77     # The top-level interface to PerfTest.
  78     # COMPILE is the tcl code to generate and compile source files.
  79     # STARTUP is the tcl code to start up GDB.
  80     # RUN is the tcl code to drive GDB to do some operations.
  81     # Each of COMPILE, STARTUP, and RUN return zero if successful, and
  82     # non-zero if there's a failure.
  83
  84     proc assemble {compile startup run} {
  85         global GDB_PERFTEST_MODE
  86
  87         if ![info exists GDB_PERFTEST_MODE] {
  88             return
  89         }
  90
  91         if { [string compare $GDB_PERFTEST_MODE "run"] != 0 } {
  92             if { [eval compile {$compile}] } {
  93                 untested "failed to compile"
  94                 return
  95             }
  96         }
  97
  98         # Don't execute the run if GDB_PERFTEST_MODE=compile.
  99         if { [string compare $GDB_PERFTEST_MODE "compile"] == 0} {
 100             return
 101         }
 102
 103         verbose -log "PerfTest::assemble, startup ..."
 104
 105         if [eval startup {$startup}] {
 106             fail "startup"
 107             return
 108         }
 109
 110         verbose -log "PerfTest::assemble, done startup"
 111
 112         _setup_perftest
 113
 114         verbose -log "PerfTest::assemble, run ..."
 115
 116         if [eval run {$run}] {
 117             fail "run"
 118         }
 119
 120         verbose -log "PerfTest::assemble, run complete."
 121
 122         _teardown_perftest
 123     }
 124 }
 125
 126 # Return true if performance tests are skipped.
 127
 128 proc skip_perf_tests { } {
 129     global GDB_PERFTEST_MODE
 130
 131     if [info exists GDB_PERFTEST_MODE] {
 132         if { "$GDB_PERFTEST_MODE" != "compile"
 133              && "$GDB_PERFTEST_MODE" != "run"
 134              && "$GDB_PERFTEST_MODE" != "both" } {
 135             error "Unknown value of GDB_PERFTEST_MODE."
 136             return 1
 137         }
 138
 139         return 0
 140     }
 141
 142     return 1
 143 }
 144
 145 # Given a list of tcl strings, return the same list as the text form of a
 146 # python list.
 147
 148 proc tcl_string_list_to_python_list { l } {
 149     proc quote { text } {
 150         return "\"$text\""
 151     }
 152     set quoted_list ""
 153     foreach elm $l {
 154         lappend quoted_list [quote $elm]
 155     }
 156     return "([join $quoted_list {, }])"
 157 }