blob: 6e606718e5388f15a561c507f3b3ae306161d38a (
plain)
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
|
# check.exp
#
# This script searches the systemtap.examples directory for .meta files
# The .meta files contain information categorizing the script. The
# .meta files are composed of lines of tags. Each tag is followed by a
# value.
#open the file and read in all the lines of data in FILE
#return a string with the data
proc get_meta_data { FILE } {
set meta_data ""
if [catch {open "$FILE" RDONLY} fl] {
puts "open $FILE failed: $err"
return ""
} else {
set meta_data [read -nonewline $fl]
close $fl
return "$meta_data"
}
}
#extract value for TAG from string META_DATA
#if there is no matching tag return ""
proc extract_tag { META_DATA TAG } {
set taglines ""
set value ""
set expr "^$TAG: \[^\r\n\]*"
regexp -line -all $expr $META_DATA taglines
set expr "^$TAG: "
regsub -line $expr $taglines "" value
verbose -log "meta taglines '$taglines' tag '$TAG' value '$value'"
return $value
}
proc run_command { test action command } {
#FIXME tcl says that single quotes not dealt with
if { $command != "" } then {
verbose -log "attempting command $command"
set res [catch {exec sh -c $command 2>@1} value]
verbose -log "OUT $value"
verbose -log "RC $res"
if { $res != 0 } { # allow failure for support
if { $action != "support" } { fail "$test $action" }
return $res
} else {
pass "$test $action"
return $res
}
} else {
untested "$test $action"
return 0
}
}
set curdir [pwd]
set src_examples $srcdir/systemtap.examples
set meta_files [lsort [exec find $src_examples -path "*.meta"]]
foreach file $meta_files {
set dir [file dirname $file]
set test [regsub {.*/testsuite/} $file ""]
set test [regsub {.meta} $test ""]
cd $dir
set meta_data [get_meta_data $file]
set test_support [extract_tag "$meta_data" "test_support"]
set command $test_support
set supported_p 1
if { $command != "" } { # need to test support
set res [run_command "$test" "support" $command]
if { $res != 0 } { set supported_p 0 }
}
if { $supported_p == 1 } {
set test_check [extract_tag "$meta_data" "test_check"]
set command $test_check
run_command "$test" "build" $command
} else {
untested "$test build"
}
set test_installcheck [extract_tag "$meta_data" "test_installcheck"]
# The pass/fail logic too simple and fails for some examples
# FIXME would like to be able to run more complicated test code
if {[info procs installtest_p] != "" && [installtest_p]
&& $test_installcheck != "" } then {
if { $supported_p == 1 } {
set command $test_installcheck
run_command "$test" "run" $command
} else {
untested "$test run"
}
}
}
cd $curdir
|
