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
158
159
160
161
162
163
164
165
|
set test "tcl"
# Test sdt support in tcl.
global env
if {! [info exists env(SYSTEMTAP_TEST_SDT)]} {
unsupported "tcl (\"SYSTEMTAP_TEST_SDT\" not in env)"
return
}
########## Create /tmp/stap-tcl.stp ##########
set tclreleasemajor "8.6"
set tclrelease "8.6b1"
set tcldir "[pwd]/tcl/install/"
set testsuite "[pwd]"
set fp [open "$testsuite/stap-tcl.stp" "w"]
puts $fp "
probe process(@1).mark(\"proc__entry\")
{
printf (\"%s %#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3)
}
probe process(@1).mark(\"proc__return\")
{
printf (\"%s %#x,%#x\\n\",\$\$name, \$arg1,\$arg2)
}
probe process(@1).mark(\"proc__result\")
{
printf (\"%s %#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4)
}
probe process(@1).mark(\"proc__args\")
{
printf (\"%s %#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4,\$arg5,\$arg6,\$arg7,\$arg8,\$arg9,\$arg10)
}
probe process(@1).mark(\"proc__info\")
{
printf (\"%s %#x,%#x,%#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4,\$arg5,\$arg6)
}
probe process(@1).mark(\"cmd__entry\")
{
printf (\"%s %#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3)
}
probe process(@1).mark(\"cmd__return\")
{
printf (\"%s %#x,%#x\\n\",\$\$name, \$arg1,\$arg2)
}
probe process(@1).mark(\"cmd__result\")
{
printf (\"%s %#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4)
}
probe process(@1).mark(\"cmd__args\")
{
printf (\"%s %#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4,\$arg5,\$arg6,\$arg7,\$arg8,\$arg9,\$arg10)
}
probe process(@1).mark(\"cmd__info\")
{
printf (\"%s %#x,%#x,%#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4,\$arg5,\$arg6)
}
probe process(@1).mark(\"inst__start\")
{
printf (\"%s %#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3)
}
probe process(@1).mark(\"inst__done\")
{
printf (\"%s %#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3)
}
probe process(@1).mark(\"obj__create\")
{
printf (\"%s %#x\\n\",\$\$name, \$arg1)
}
probe process(@1).mark(\"obj__free\")
{
printf (\"%s %#x\\n\",\$\$name, \$arg1)
}
probe process(@1).mark(\"tcl__probe\")
{
printf (\"%s %#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x,%#x\\n\",\$\$name, \$arg1,\$arg2,\$arg3,\$arg4,\$arg5,\$arg6,\$arg7,\$arg8,\$arg9,\$arg10)
}
"
close $fp
########## Begin /tmp/stap-tcl.sh ##########
set fp [open "$testsuite/stap-tcl.sh" "w"]
puts $fp "
##### begin run_tests #####
function run_tests \{
(cd $tcldir/..
MOD=stapsdt_\$(date +%j%k%M%N | sed 's/ //')
$env(SYSTEMTAP_PATH)/stap -m \$MOD -c install/bin/tclsh$tclreleasemajor $testsuite/stap-tcl.stp $testsuite/tcl/install/lib//libtcl$tclreleasemajor.so << END >$testsuite/stap-tcl-markers.log 2>&1
source src/tests/all.tcl
quit
END
)
PROC_ENTRY=\$(grep 'proc__entry' $testsuite/stap-tcl-markers.log | wc -l)
PROC_RETURN=\$(grep 'proc__return' $testsuite/stap-tcl-markers.log | wc -l)
PROC_RESULT=\$(grep 'proc__result' $testsuite/stap-tcl-markers.log | wc -l)
PROC_ARGS=\$(grep 'proc__args' $testsuite/stap-tcl-markers.log | wc -l)
PROC_INFO=\$(grep 'proc__info' $testsuite/stap-tcl-markers.log | wc -l)
CMD_ENTRY=\$(grep 'cmd__entry' $testsuite/stap-tcl-markers.log | wc -l)
CMD_RETURN=\$(grep 'cmd__return' $testsuite/stap-tcl-markers.log | wc -l)
CMD_RESULT=\$(grep 'cmd__result' $testsuite/stap-tcl-markers.log | wc -l)
CMD_ARGS=\$(grep 'cmd__args' $testsuite/stap-tcl-markers.log | wc -l)
CMD_INFO=\$(grep 'cmd__info' $testsuite/stap-tcl-markers.log | wc -l)
INST_START=\$(grep 'inst__start' $testsuite/stap-tcl-markers.log | wc -l)
INST_DONE=\$(grep 'inst__done' $testsuite/stap-tcl-markers.log | wc -l)
OBJ_CREATE=\$(grep 'obj__create' $testsuite/stap-tcl-markers.log | wc -l)
OBJ_FREE=\$(grep 'obj__free' $testsuite/stap-tcl-markers.log | wc -l)
echo PROC_ENTRY=\$PROC_ENTRY PROC_RETURN=\$PROC_RETURN PROC_RESULT=\$PROC_RESULT PROC_ARGS=\$PROC_ARGS PROC_INFO=\$PROC_INFO CMD_ENTRY=\$CMD_ENTRY CMD_RETURN=\$CMD_RETURN CMD_RESULT=\$CMD_RESULT CMD_ARGS=\$CMD_ARGS CMD_INFO=\$CMD_INFO INST_START=\$INST_START INST_DONE=\$INST_DONE OBJ_CREATE=\$OBJ_CREATE OBJ_FREE=\$OBJ_FREE
if \[ \$PROC_ENTRY -gt 9000 -a \$PROC_RETURN -gt 9000 -a \$PROC_RESULT -gt 9000 -a \$PROC_ARGS -gt 9000 -a \$PROC_INFO -gt 9000 -a \$CMD_ENTRY -gt 37000 -a \$CMD_RETURN -gt 37000 -a \$CMD_RESULT -gt 37000 -a \$CMD_ARGS -gt 3700 -a \$CMD_INFO -gt 37000 -a \$INST_START -gt 542000 -a \$INST_DONE -gt 542000 -a \$OBJ_CREATE -gt 723000 -a \$OBJ_FREE -gt 704000 \] ; then
echo PASS: tcl markers \$1
else
echo FAIL: tcl markers \$1
fi
\}
##### end run_tests #####
if \[ ! -r tcl$tclrelease-src.tar.gz \] ; then
wget http://sourceforge.net/projects/tcl/files/Tcl/$tclrelease/tcl$tclrelease-src.tar.gz/download
fi
if \[ ! -d tcl/src \] ; then
tar -x -z -f tcl$tclrelease-src.tar.gz
mkdir tcl
mv tcl$tclrelease tcl/src
fi
if \[ ! -d tcl/install/bin \] ; then
cd tcl/src/unix
./configure --prefix=$tcldir --enable-dtrace CFLAGS='-I$env(SYSTEMTAP_INCLUDES) -g'
make -j2
make install
fi
run_tests uprobe
"
########## End /tmp/stap-tcl.sh ##########
close $fp
########## /tmp/stap-tcl.sh does most of the work ##########
verbose -log Running tcl testsuite
spawn sh stap-tcl.sh 2>&1
expect {
-timeout 1000
-re {FAIL: [a-z_ ]+} { regexp " .*$" $expect_out(0,string) s;
fail "$s"; exp_continue }
-re {PASS: [a-z_ ]+} { regexp " .*$" $expect_out(0,string) s;
pass "$s"; exp_continue }
-re {UNSUPPORTED: [a-zA-Z_/: ]+} { regexp " .*$" $expect_out(0,string) s;
verbose -log "$s"
unsupported "$s"; exp_continue }
timeout { fail "$test (timeout)" }
eof { }
}
if { $verbose == 0 } {
catch {exec rm -rf $testsuite/stap-tcl.stp tcl$tclrelease-src.tar.gz \
$testsuite/stap-tcl-markers.log $testsuite/stap-tcl.sh }
catch {exec rm -rf tcl}
}
|
