gdb/testsuite/lib/perftest.exp

   1 # Copyright (C) 2013-2022 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         with_test_prefix "setup perftest" {
  29             gdb_test_no_output "python import os, sys"
  30             gdb_test_no_output \
  31                 "python sys.path.insert\(0, os.path.abspath\(\"${srcdir}/${subdir}/lib\"\)\)" \
  32                 "python sys.path.insert\(0, os.path.abspath\(\"\${srcdir}/${subdir}/lib\"\)\)"
  33             gdb_test_no_output \
  34                 "python exec (open ('${remote_python_file}').read ())" \
  35                 "python exec (open ('\${srcdir}/${subdir}/${testfile}.py').read ())"
  36         }
  37     }
  38
  39     # A private method to do some cleanups when performance test is
  40     # finished.
  41     proc _teardown_perftest {} {
  42         variable remote_python_file
  43
  44         remote_file host delete $remote_python_file
  45     }
  46
  47     # Compile source files of test case.  BODY is the tcl code to do
  48     # actual compilation.  Return zero if compilation is successful,
  49     # otherwise return non-zero.
  50     proc compile {body} {
  51         return [uplevel 2 $body]
  52     }
  53
  54     # Run the startup code.  Return zero if startup is successful,
  55     # otherwise return non-zero.
  56     proc startup {body} {
  57         return [uplevel 2 $body]
  58     }
  59
  60     # Start up GDB.
  61     proc startup_gdb {body} {
  62         uplevel 2 $body
  63     }
  64
  65     # Run the performance test.  Return zero if the run is successful,
  66     # otherwise return non-zero.
  67     proc run {body} {
  68         global timeout
  69         global GDB_PERFTEST_TIMEOUT
  70
  71         set oldtimeout $timeout
  72         if { [info exists GDB_PERFTEST_TIMEOUT] } {
  73             set timeout $GDB_PERFTEST_TIMEOUT
  74         } else {
  75             set timeout 3000
  76         }
  77         set result [uplevel 2 $body]
  78
  79         set timeout $oldtimeout
  80         return $result
  81     }
  82
  83     # The top-level interface to PerfTest.
  84     # COMPILE is the tcl code to generate and compile source files.
  85     # STARTUP is the tcl code to start up GDB.
  86     # RUN is the tcl code to drive GDB to do some operations.
  87     # Each of COMPILE, STARTUP, and RUN return zero if successful, and
  88     # non-zero if there's a failure.
  89
  90     proc assemble {compile startup run} {
  91         global GDB_PERFTEST_MODE
  92
  93         if ![info exists GDB_PERFTEST_MODE] {
  94             return
  95         }
  96
  97         if { [string compare $GDB_PERFTEST_MODE "run"] != 0 } {
  98             if { [eval compile {$compile}] } {
  99                 untested "failed to compile"
 100                 return
 101             }
 102         }
 103
 104         # Don't execute the run if GDB_PERFTEST_MODE=compile.
 105         if { [string compare $GDB_PERFTEST_MODE "compile"] == 0} {
 106             return
 107         }
 108
 109         verbose -log "PerfTest::assemble, startup ..."
 110
 111         if [eval startup {$startup}] {
 112             fail "startup"
 113             return
 114         }
 115
 116         verbose -log "PerfTest::assemble, done startup"
 117
 118         _setup_perftest
 119
 120         verbose -log "PerfTest::assemble, run ..."
 121
 122         if [eval run {$run}] {
 123             fail "run"
 124         }
 125
 126         verbose -log "PerfTest::assemble, run complete."
 127
 128         _teardown_perftest
 129     }
 130 }
 131
 132 # Return true if performance tests are skipped.
 133
 134 proc skip_perf_tests { } {
 135     global GDB_PERFTEST_MODE
 136
 137     if [info exists GDB_PERFTEST_MODE] {
 138         if { "$GDB_PERFTEST_MODE" != "compile"
 139              && "$GDB_PERFTEST_MODE" != "run"
 140              && "$GDB_PERFTEST_MODE" != "both" } {
 141             error "Unknown value of GDB_PERFTEST_MODE."
 142             return 1
 143         }
 144
 145         return 0
 146     }
 147
 148     return 1
 149 }
 150
 151 # Given a list of tcl strings, return the same list as the text form of a
 152 # python list.
 153
 154 proc tcl_string_list_to_python_list { l } {
 155     proc quote { text } {
 156         return "\"$text\""
 157     }
 158     set quoted_list ""
 159     foreach elm $l {
 160         lappend quoted_list [quote $elm]
 161     }
 162     return "([join $quoted_list {, }])"
 163 }
 164
 165 # Helper routine for PerfTest::assemble "run" step implementations.
 166 # Issues the "python ${OBJ}.run()" command, and consumes GDB output
 167 # line by line.  Issues a FAIL if the command fails with a Python
 168 # error.  Issues a PASS on success.  MESSAGE is an optional message to
 169 # be printed.  If this is omitted, then the pass/fail messages use the
 170 # command string as the message.
 171
 172 proc gdb_test_python_run {obj {message ""}} {
 173     global gdb_prompt
 174
 175     set saw_error 0
 176     gdb_test_multiple "python ${obj}.run()" $message {
 177         -re "Error while executing Python code\\." {
 178             set saw_error 1
 179             exp_continue
 180         }
 181         -re "\[^\r\n\]*\r\n" {
 182             exp_continue
 183         }
 184         -re "$gdb_prompt $" {
 185             gdb_assert {!$saw_error} $gdb_test_name
 186         }
 187     }
 188 }