File: test_simple.exp

package info (click to toggle)
systemtap 5.3-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 47,556 kB
  • sloc: cpp: 81,117; ansic: 54,933; xml: 49,795; exp: 43,595; sh: 11,526; python: 5,003; perl: 2,252; tcl: 1,312; makefile: 1,006; javascript: 149; lisp: 105; awk: 101; asm: 91; java: 70; sed: 16
file content (239 lines) | stat: -rw-r--r-- 8,117 bytes parent folder | download | duplicates (2)
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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
# test_simple.exp
#
# Simple commands for running user shell commands and checking their outputs.
# Also provided commands for generic string value and boolean value checks.

# run_cmd_2way CMD STDOUT_VAR STDERR_VAR
# * CMD is a string value for the user shell command to run.
# * STDOUT_VAR is the (output) variable name (without the `$` prefix!) to hold
#   the stdout output.
# * STDERR_VAR is the (output) variable name (without the `$` prefix!) to hold
#   the stderr output.
# Returns the exit code number
# TODO add timeout protection

proc run_cmd_2way { cmd stdout_var stderr_var } {
    upvar 1 $stdout_var stdout
    upvar 1 $stderr_var stderr

    send_log "executing: $cmd\n"

    set pipe [open "| sh -c {$cmd}" r]
    set stdout [read $pipe]
    set exit_code 0
    if {[catch {close $pipe} stderr] != 0} {
        if {$stderr ne "" && [string index $stderr end] ne "\n"} {
            # Alas. close() automatically remove the trailing newline, so we
            # have to add it back here...
            append stderr "\n"
        }
        global errorCode
        if {[lindex $errorCode 0] eq "CHILDSTATUS"} {
            set exit_code [lindex $errorCode 2]
        }
    }

    return $exit_code
}

# run_cmd_2way_as_root CMD STDOUT_VAR STDERR_VAR
# similar to run_cmd_2way but runs the command as root.

proc run_cmd_2way_as_root { cmd stdout_var stderr_var } {
    set effective_uid [exec /usr/bin/id -u]

    if {$effective_uid != 0} {
        set cmd "sudo $cmd"
    }

    upvar 1 $stdout_var tmp_stdout
    upvar 1 $stderr_var tmp_stderr

    return [run_cmd_2way $cmd tmp_stdout tmp_stderr]
}

# like TEST_NAME GOT REGEX_PATTERN REGEX_OPTS
# The test passes when the TARGET_STR string matches the regex in REGEX_PATTERN.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * REGEX_PATTERN is a tcl regular expression string to be matched against.
# * REGEX_OPTS is optional regex options like -expanded and -nocase.
# Returns 1 when the check passes, 0 otherwise.

proc like { test_name target regex regex_opts } {
    regsub -all -- {\n} $regex {\n} escaped_regex
    if {[regexp {*}$regex_opts -- $regex $target]} {
        pass "${test_name}: matches regex \"$escaped_regex\""
        return 1
    }
    fail "${test_name}: fails to match regex \"$escaped_regex\": got \"$target\""
    return 0
}

# unlike TEST_NAME GOT REGEX_PATTERN REGEX_OPTS
# The test passes when the GOT string does NOT match the regex in
# REGEX_PATTERN.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * REGEX_PATTERN is a tcl regular expression string to be matched against.
# * REGEX_OPTS is optional regex options like -expanded and -nocase.
# Returns 1 when the check passes, 0 otherwise.

proc unlike { test_name got regex regex_opts } {
    regsub -all -- {\n} $regex {\n} escaped_regex
    if {[regexp {*}$regex_opts -- $regex $got]} {
        fail "${test_name}: should NOT match regex \"$escaped_regex\" but matches: got \"$got\""
        return 0
    }
    pass "${test_name}: matches regex \"$escaped_regex\""
    return 1
}

# is TEST_NAME GOT EXPECTED
# The test passes when the GOT string is (exactly) equal to the string EXPECTED.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * EXPECTED is the expected string to be matched.
# Returns 1 when the check passes, 0 otherwise.

proc is { test_name got expected } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {$got eq $expected} {
        pass "${test_name}: string is \"$escaped_exp\""
        return 1
    }
    fail "${test_name}: string should be \"$escaped_exp\", but got \"$got\""
    return 0
}

# isnt TEST_NAME GOT EXPECTED
# The test passes when the GOT string is NOT equal to the string EXPECTED.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * EXPECTED is the expected string to be matched.
# Returns 1 when the check passes, 0 otherwise.

proc isnt { test_name got expected } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {$got eq $expected} {
        fail "${test_name}: string should NOT be \"$escaped_exp\", but got \"$got\""
        return 0
    }
    pass "${test_name}: string should NOT be \"$escaped_exp\""
    return 1
}

# ok TEST_NAME RESULT
# The test passes when RESULT is a true value in Tcl.
# * TEST_NAME is a string describing the current check.
# * RESULT is the boolean value to be checked
# Returns 1 when the check passes, 0 otherwise.

proc ok { test_name result } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {! $result} {
        fail "${test_name}: not ok: $result"
        return 0
    }
    pass "${test_name}: ok: $result"
    return 1
}

# nok TEST_NAME RESULT
# The test passes when RESULT is a *false* value in Tcl.
# * TEST_NAME is a string describing the current check.
# * RESULT is the boolean value to be checked
# Returns 1 when the check passes, 0 otherwise.

proc nok { test_name result } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {$result} {
        fail "${test_name}: should NOT be ok but is ok: $result"
        return 0
    }
    pass "${test_name}: sould NOT be ok: $result"
    return 1
}

# process_template_file TEMPLATE_FILE OUT_FILE BIN_FILE ERR_VAR
# Processes the template file specified by the TEMPLATE_FILE argument,
# expands special macro variables in the template file, and genetates the final
# .stp file specified by the OUT_FILE argument.
# The following macro variables are supported:
# * $^PWD for the current working directory
# * $^ADDR_NAME for the hex address (without the 0x prefix) for the symbol
#   named NAME by inspecting the binary target program file BIN_FILE via the
#   nm utility.
# Returns 1 when all macro variables are expanded successfully; 0 otherwise.
# In case of error, the error message will be returned in the variable with
# the name specified by the 4th argument.

proc process_template_file { template_file out_file bin_file err_var } {
    upvar 1 $err_var err

    set in [open $template_file r]
    set src [read $in]
    close $in

    set cwd [pwd]
    regsub -all -- {\$\^PWD\y} $src $cwd src

    set matches [regexp -all -inline -- {\$\^ADDR_([_a-zA-Z]\w*)} $src]

    set nsyms 0
    if {[llength $matches] > 0} {
        array set names {}
        foreach {match, name} $matches {
            if {! [info exists names($name)]} {
                incr nsyms
                set names($name) 1
            }
        }

        set nm_fh [open "| nm --defined-only ./a.out" r]
        set hits 0
        while {[gets $nm_fh line] >= 0} {
            if {[regexp -- {^\s*([0-9a-f]+)\s+[DTBdtb]\s+([_a-zA-Z]\w*)\s*$} $line \
                    match addr name]} {
                if {! [info exists names($name)]} {
                    continue
                }
                unset names($name)
                send_log "found symbol '$name' at addr $addr in the nm output\n"
                regsub -all -- "\\$\\^ADDR_$name\\y" $src $addr src
                if {[incr hits] == $nsyms} {
                    break
                }
            }
        }

        if {[catch {close $nm_fh} nm_err] != 0} {
            global errorCode
            if {[lindex $errorCode 0] eq "CHILDSTATUS"} {
                if {[lindex $errorCode 2] != 0} {
                    set err "failed to run nm: $nm_err"
                    return 0
                }
            }
        }

        if {$hits < $nsyms} {
            set unmatched_names [array names names]
            if {[llength $unmatched_names] == 1} {
                set sym [lindex $unmatched_names 0]
                set err "symbol '$sym' not found in binary file $bin_file"
                return 0
            }

            set sym_list [join [lmap e [array names names] { expr {"'$e'"} }] ", "]
            set err "symbols $sym_list not found in binary file $bin_file"
            return 0
        }
    }

    set out [open $out_file w+]
    puts -nonewline $out $src
    close $out

    return 1
}