← Back to branch summary

~ubuntu-branches/ubuntu/trusty/dejagnu/trusty-proposed

« back to all changes in this revision

Viewing changes to lib/utils.exp

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Jacobowitz
  • Date: 2006-12-11 09:06:59 UTC
  • mfrom: (2.1.6 edgy)
  • Revision ID: james.westby@ubuntu.com-20061211090659-w586kgi3giz84053
Tags: 1.4.4.cvs20060709-3
* Acknowledge previous NMUs.
* Fix permissions on /usr/share/dejagnu when building without fakeroot
  (Closes: #392589, #379809).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/utils.exp
1
1
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
2
 
# 2001, 2002, 2003 Free Software Foundation, Inc.
 
2
# 2001, 2002, 2003, 2005 Free Software Foundation, Inc.
3
3
#
4
4
# This file is part of DejaGnu.
5
5
#
15
15
#
16
16
# You should have received a copy of the GNU General Public License
17
17
# along with DejaGnu; if not, write to the Free Software Foundation,
18
 
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
18
# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
19
19
 
20
20
# This file was written by Rob Savoye. (rob@welcomehome.org)
21
21
 
22
 
#
23
 
# Most of the procedures found here mimic their unix counter-part.
24
 
# This file is sourced by runtest.exp, so they are usable by any test case.
25
 
#
 
22
# Most of the procedures found here mimic their UNIX counterpart.
 
23
# This file is sourced by runtest.exp, so they are usable by any test
 
24
# script.
26
25
 
27
 
#
28
26
# Gets the directories in a directory, or in a directory tree.
29
27
#     args: the first is the dir to look in, the next
30
28
#         is the pattern to match. It
51
49
    catch "glob ${path}/${pattern}" tmp
52
50
    if { ${tmp} != "" } {
53
51
        foreach i ${tmp} {
54
 
            if [file isdirectory $i] {
 
52
            if {[file isdirectory $i]} {
55
53
                switch -- "[file tail $i]" {
56
54
                    "testsuite" -
57
55
                    "config" -
63
61
                        continue
64
62
                    }
65
63
                    default {
66
 
                        if [file readable $i] {
 
64
                        if {[file readable $i]} {
67
65
                            verbose "Found directory [file tail $i]" 3
68
66
                            lappend dirs $i
69
67
                            if { $alldirs } {
79
77
        return ""
80
78
    }
81
79
 
82
 
    if ![info exists dirs] {
 
80
    if {![info exists dirs]} {
83
81
        return ""
84
82
    } else {
85
83
        return $dirs
86
84
    }
87
85
}
88
86
 
89
 
#
90
87
# Finds paths of all non-directory files, recursively, whose names match
91
88
# a pattern.  Certain directory name are not searched (see proc getdirs).
92
89
#     rootdir - search in this directory and its subdirectories, recursively.
106
103
    foreach i $dirs {
107
104
        verbose "Looking in $i" 3
108
105
        foreach match [glob -nocomplain $i/$pattern] {
109
 
            if ![file isdirectory $match] {
 
106
            if {![file isdirectory $match]} {
110
107
                lappend files $match
111
108
                verbose "Adding $match to file list" 3
112
109
            }
116
113
    return $files
117
114
}
118
115
 
119
 
#
120
 
# Search the path for a file. This is basically a version
121
 
# of the BSD-unix which utility. This procedure depends on
122
 
# the shell environment variable $PATH. It returns 0 if $PATH
123
 
# does not exist or the binary is not in the path. If the
124
 
# binary is in the path, it returns the full path to the binary.
 
116
# Search the path for a file. This is basically a version of the BSD
 
117
# Unix which(1) utility. This procedure depends on the shell
 
118
# environment variable $PATH. It returns 0 if $PATH does not exist or
 
119
# the binary is not in the path. If the binary is in the path, it
 
120
# returns the full path to the binary.
125
121
#
126
122
proc which { file } {
127
123
    global env
131
127
 
132
128
    # if it exists then the path must be OK
133
129
    # ??? What if $file has no path and "." isn't in $PATH?
134
 
    if [file exists $file] {
 
130
    if {[file exists $file]} {
135
131
        return $file
136
132
    }
137
 
    if [info exists env(PATH)] {
 
133
    if {[info exists env(PATH)]} {
138
134
        set path [split $env(PATH) ":"]
139
135
    } else {
140
136
        return 0
142
138
 
143
139
    foreach i $path {
144
140
        verbose "Checking against $i" 3
145
 
        if [file exists $i/$file] {
146
 
            if [file executable $i/$file] {
147
 
                return $i/$file
 
141
        if {[file exists [file join $i $file]]} {
 
142
            if {[file executable [file join $i $file]]} {
 
143
                return [file join $i $file]
148
144
            } else {
149
 
                warning "$i/$file exists but is not an executable"
 
145
                warning "[file join $i $file] exists but is not an executable"
150
146
            }
151
147
        }
152
148
    }
154
150
    return 0
155
151
}
156
152
 
157
 
#
158
 
# Looks for a string in a file.
 
153
# Looks for occurrences of a string in a file.
159
154
#     return:list of lines that matched or NULL if none match.
160
155
#     args:  first arg is the filename,
161
156
#            second is the pattern,
183
178
    set fd [open $file r]
184
179
    while { [gets $fd cur_line]>=0 } {
185
180
        incr i
186
 
        if [regexp -- "$pattern" $cur_line match] {
187
 
            if ![string match "" $options] {
 
181
        if {[regexp -- "$pattern" $cur_line match]} {
 
182
            if {![string match "" $options]} {
188
183
                foreach opt $options {
189
 
                    case $opt in {
 
184
                    switch $opt {
190
185
                        "line" {
191
186
                            lappend grep_out [concat $i $match]
192
187
                        }
200
195
    close $fd
201
196
    unset fd
202
197
    unset i
203
 
    if ![info exists grep_out] {
 
198
    if {![info exists grep_out]} {
204
199
        set grep_out ""
205
200
    }
206
201
    return $grep_out
216
211
    set tmp {}
217
212
    foreach i $list {
218
213
        verbose "Checking pattern \"$pattern\" against $i" 3
219
 
        if ![string match $pattern $i] {
 
214
        if {![string match $pattern $i]} {
220
215
            lappend tmp $i
221
216
        } else {
222
217
            verbose "Removing element $i from list" 3
231
226
proc slay { name } {
232
227
    set in [open [concat "|ps"] r]
233
228
    while {[gets $in line]>-1} {
234
 
        if ![string match "*expect*slay*" $line] {
235
 
            if [string match "*$name*" $line] {
 
229
        if {![string match "*expect*slay*" $line]} {
 
230
            if {[string match "*$name*" $line]} {
236
231
                set pid [lindex $line 0]
237
 
                catch "exec kill -9 $pid]"
 
232
                catch "exec kill -9 $pid"
238
233
                verbose "Killing $name, pid = $pid\n"
239
234
            }
240
235
        }
246
241
# Convert a relative path to an absolute one on the local machine.
247
242
#
248
243
proc absolute { path } {
249
 
    if [string match "." $path] {
 
244
    if {[string match "." $path]} {
250
245
        return [pwd]
251
246
    }
252
247
 
266
261
    global errorCode
267
262
 
268
263
    unset errorInfo
269
 
    if [file exists $file] {
 
264
    if {[file exists $file]} {
270
265
        catch "source $file"
271
 
        if [info exists errorInfo] {
 
266
        if {[info exists errorInfo]} {
272
267
            send_error "ERROR: errors in $file\n"
273
268
            send_error "$errorInfo"
274
269
            return 1
290
285
# Eg: RUNTESTFLAGS="bar.exp=foo1.c foo2.c foo3*.c bar/baz*.c"
291
286
#
292
287
proc runtest_file_p { runtests testcase } {
293
 
    if [string length [lindex $runtests 1]] {
 
288
    if {[string length [lindex $runtests 1]]} {
294
289
        foreach ptn [lindex $runtests 1] {
295
 
            if [string match "*/$ptn" $testcase] {
 
290
            if {[string match "*/$ptn" $testcase]} {
296
291
                return 1
297
292
            }
298
 
            if [string match $ptn $testcase] {
 
293
            if {[string match $ptn $testcase]} {
299
294
                return 1
300
295
            }
301
296
        }
323
318
    set eof -1
324
319
    set differences 0
325
320
 
326
 
    if [file exists ${file_1}] {
 
321
    if {[file exists ${file_1}]} {
327
322
        set file_a [open ${file_1} r]
328
323
    } else {
329
324
        warning "${file_1} doesn't exist"
330
325
        return 0
331
326
    }
332
327
 
333
 
    if [file exists ${file_2}] {
 
328
    if {[file exists ${file_2}]} {
334
329
        set file_b [open ${file_2} r]
335
330
    } else {
336
331
        warning "${file_2} doesn't exist"
341
336
 
342
337
    set list_a ""
343
338
    while { [gets ${file_a} line] != ${eof} } {
344
 
        if [regexp "^#.*$" ${line}] {
 
339
        if {[regexp "^#.*$" ${line}]} {
345
340
            continue
346
341
        } else {
347
342
            lappend list_a ${line}
351
346
 
352
347
    set list_b ""
353
348
    while { [gets ${file_b} line] != ${eof} } {
354
 
        if [regexp "^#.*$" ${line}] {
 
349
        if {[regexp "^#.*$" ${line}]} {
355
350
            continue
356
351
        } else {
357
352
            lappend list_b ${line}
364
359
 
365
360
        #        verbose "\t${file_1}: ${i}: ${line_a}\n" 3
366
361
        #        verbose "\t${file_2}: ${i}: ${line_b}\n" 3
367
 
        if [string compare ${line_a} ${line_b}] {
 
362
        if {[string compare ${line_a} ${line_b}]} {
368
363
            verbose "line #${i}\n" 2
369
364
            verbose "\< ${line_a}\n" 2
370
365
            verbose "\> ${line_b}\n" 2
410
405
proc getenv { var } {
411
406
    global env
412
407
 
413
 
    if [info exists env($var)] {
 
408
    if {[info exists env($var)]} {
414
409
        return $env($var)
415
410
    } else {
416
411
        return ""