summaryrefslogtreecommitdiffstats
path: root/testsuite/systemtap.examples/check.exp
blob: 482738cc6b072b9ab25d4a874ec2b0ef03e6e37d (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
# 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:\[^\$\]*"
    regexp -line -all $expr $META_DATA taglines
    set expr "$TAG:"
    regsub -line $expr $taglines "" value
    return $value
}

proc run_command { test command } {
    #FIXME tcl says that single quotes not dealt with
    if { $command != "" } then {
	verbose -log "attempting command $command"
	# Pipe both stdout and stderr to cat, otherwise any stderr
	# output results in res being set to 1 (TCL_ERROR). This breaks
	# scripts that have WARNINGS about for example skipped probes.
	set res [catch {eval exec "$command |& cat"} value]
	verbose -log "OUT $value"
	verbose -log "RC $res"
	if {$res != 0 } {
	    fail $test
	} else {
	    pass $test
	}
    } else {
	untested $test
    }
}

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_check [extract_tag "$meta_data" "test_check"]
    set command $test_check
    run_command "$test build" $command
    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 {
	set command $test_installcheck
	run_command "$test run" $command
    }
}

cd $curdir