1 # Copyright (C) 2013-2024 Free Software Foundation, Inc.
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.
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.
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/>.
16 namespace eval PerfTest {
17 # The name of python file on build.
18 variable remote_python_file
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
25 set remote_python_file [gdb_remote_download host ${srcdir}/${subdir}/${testfile}.py]
27 # Set sys.path for module perftest.
28 with_test_prefix "setup perftest" {
29 gdb_test_no_output "python import os, sys"
31 "python sys.path.insert\(0, os.path.abspath\(\"${srcdir}/${subdir}/lib\"\)\)" \
32 "python sys.path.insert\(0, os.path.abspath\(\"\${srcdir}/${subdir}/lib\"\)\)"
34 "python exec (open ('${remote_python_file}').read ())" \
35 "python exec (open ('\${srcdir}/${subdir}/${testfile}.py').read ())"
39 # A private method to do some cleanups when performance test is
41 proc _teardown_perftest {} {
42 variable remote_python_file
44 remote_file host delete $remote_python_file
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.
51 return [uplevel 2 $body]
54 # Run the startup code. Return zero if startup is successful,
55 # otherwise return non-zero.
57 return [uplevel 2 $body]
61 proc startup_gdb {body} {
65 # Run the performance test. Return zero if the run is successful,
66 # otherwise return non-zero.
69 global GDB_PERFTEST_TIMEOUT
71 set oldtimeout $timeout
72 if { [info exists GDB_PERFTEST_TIMEOUT] } {
73 set timeout $GDB_PERFTEST_TIMEOUT
77 set result [uplevel 2 $body]
79 set timeout $oldtimeout
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.
90 proc assemble {compile startup run} {
91 global GDB_PERFTEST_MODE
93 if ![info exists GDB_PERFTEST_MODE] {
97 if { [string compare $GDB_PERFTEST_MODE "run"] != 0 } {
98 if { [eval compile {$compile}] } {
99 untested "failed to compile"
104 # Don't execute the run if GDB_PERFTEST_MODE=compile.
105 if { [string compare $GDB_PERFTEST_MODE "compile"] == 0} {
109 verbose -log "PerfTest::assemble, startup ..."
111 if [eval startup {$startup}] {
116 verbose -log "PerfTest::assemble, done startup"
120 verbose -log "PerfTest::assemble, run ..."
122 if [eval run {$run}] {
126 verbose -log "PerfTest::assemble, run complete."
132 # Return true if performance tests are to be run.
134 proc allow_perf_tests { } {
135 global GDB_PERFTEST_MODE
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."
151 # Given a list of tcl strings, return the same list as the text form of a
154 proc tcl_string_list_to_python_list { l } {
155 proc quote { text } {
160 lappend quoted_list [quote $elm]
162 return "([join $quoted_list {, }])"
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.
172 proc gdb_test_python_run {obj {message ""}} {
176 gdb_test_multiple "python ${obj}.run()" $message {
177 -re "Error while executing Python code\\." {
181 -re "\[^\r\n\]*\r\n" {
184 -re "$gdb_prompt $" {
185 gdb_assert {!$saw_error} $gdb_test_name