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