2009-07-12 21:37:57 +02:00
# Source `init.tcl' again to restore the `unknown' procedure
# NOTE: DejaGnu has an old `unknown' procedure which unfortunately disables
# tcl auto-loading.
source [file join [info library] init.tcl]
package require textutil::string
2009-12-10 23:53:22 +02:00
# Execute a bash command and make sure the exit status is successful.
2009-06-09 22:49:53 +02:00
# If not, output the error message.
2009-12-10 23:53:22 +02:00
# @param string $cmd Bash command line to execute. If empty string (""), the
2009-06-09 22:49:53 +02:00
# exit status of the previously executed bash command will be
# checked; specify `title' to adorn the error message.
# @param string $title (optional) Command title. If empty, `cmd' is used.
2009-07-17 16:15:02 +02:00
# @param string $prompt (optional) Bash prompt. Default is "/@"
2010-01-24 10:32:41 +01:00
# @param mixed $out (optional) Reference to (tcl) variable to hold output.
2009-09-26 11:00:02 +02:00
# If variable equals -1 (default) the bash command is expected
# to return no output. If variable equals 0, any output
# from the bash command is disregarded.
proc assert_bash_exec {{aCmd ""} {title ""} {prompt /@} {out -1}} {
if {$out != 0 && $out != -1} {upvar $out results}
2009-06-09 22:49:53 +02:00
if {[string length $aCmd] != 0} {
send "$aCmd\r"
expect -ex "$aCmd\r\n"
}; # if
if {[string length $title] == 0} {set title $aCmd}
2009-07-17 16:15:02 +02:00
expect -ex $prompt
2009-09-20 13:07:04 +02:00
set results $expect_out(buffer); # Catch output
# Remove $prompt suffix from output
set results [
string range $results 0 [
2009-10-02 10:53:00 +02:00
expr [string length $results] - [string length $prompt] - 1
2009-09-20 13:07:04 +02:00
]
]
2009-09-26 11:00:02 +02:00
if {$out == -1 && [string length $results] > 0} {
if {[info exists multipass_name]} {
fail "ERROR Unexpected output from bash command \"$title\""
}; # if
send_user "ERROR Unexpected output from bash command \"$title\":\n$results"
}; # if
2009-09-20 13:07:04 +02:00
2009-06-09 22:49:53 +02:00
set cmd "echo $?"
send "$cmd\r"
expect {
2009-07-17 16:15:02 +02:00
-ex "$cmd\r\n0\r\n$prompt" {}
$prompt {
2009-06-09 22:49:53 +02:00
if {[info exists multipass_name]} {
fail "ERROR executing bash command \"$title\""
}; # if
2009-09-26 11:00:02 +02:00
send_user "ERROR executing bash command \"$title\""
2009-06-09 22:49:53 +02:00
}
}; # expect
}; # assert_bash_exec()
# Test `type ...' in bash
# Indicate "unsupported" if `type' exits with error status.
# @param string $command Command to locate
proc assert_bash_type {command} {
set test "$command should be available in bash"
set cmd "type $command &> /dev/null && echo -n 0 || echo -n 1"
send "$cmd\r"
expect "$cmd\r\n"
expect {
-ex 0 { set result true }
-ex 1 { set result false; unsupported "$test" }
}; # expect
expect "/@"
return $result
}; # assert_bash_type()
2009-08-23 09:38:19 +02:00
# Make sure the expected list is returned by executing the specified command.
# @param list $expected
# @param string $cmd Command given to generate items
2009-12-10 23:53:22 +02:00
# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions"
2009-08-23 09:38:19 +02:00
# @param string $prompt (optional) Bash prompt. Default is "/@"
# @param integer $size (optional) Chunk size. Default is 20.
# @result boolean True if successful, False if not
proc assert_bash_list {expected cmd {test ""} {prompt /@} {size 20}} {
if {$test == ""} {set test "$cmd should show expected output"}
2010-02-07 15:18:58 +01:00
if {[llength $expected] == 0} {
assert_no_output $cmd $test $prompt
2009-08-23 09:38:19 +02:00
} else {
2010-02-07 15:18:58 +01:00
send "$cmd\r"
expect -ex "$cmd\r\n"
if {[match_items $expected $test $prompt $size]} {
expect {
-re $prompt { pass "$test" }
-re eof { unresolved "eof" }
}
} else {
fail "$test"
}
}
}
2009-08-23 09:38:19 +02:00
2009-12-24 09:41:22 +01:00
proc assert_bash_list_dir {expected cmd dir {test ""} {prompt /@} {size 20}} {
set prompt "/$dir/@"
assert_bash_exec "cd $dir" "" $prompt
assert_bash_list $expected $cmd $test $prompt $size
sync_after_int $prompt
assert_bash_exec "cd \$TESTDIR"
}; # assert_bash_list_dir()
2009-07-17 16:15:02 +02:00
# Make sure the expected items are returned by TAB-completing the specified
# command.
2010-01-29 23:23:30 +01:00
# @param list $expected Expected completions.
2009-06-09 22:49:53 +02:00
# @param string $cmd Command given to generate items
2009-12-10 23:53:22 +02:00
# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions"
2009-07-17 16:15:02 +02:00
# @param string $prompt (optional) Bash prompt. Default is "/@"
2009-06-09 22:49:53 +02:00
# @param integer $size (optional) Chunk size. Default is 20.
2009-11-07 09:57:11 +01:00
# @param string $cword (optional) Last argument of $cmd which is an
# argument-to-complete and to be replaced with the longest common prefix
# of $expected. If empty string (default), `assert_complete' autodetects
# if the last argument is an argument-to-complete by checking if $cmd
2010-01-29 23:23:30 +01:00
# doesn't end with whitespace. Specifying `cword' should only be necessary
# if this autodetection fails, e.g. when the last whitespace is escaped or
2009-11-07 09:57:11 +01:00
# quoted, e.g. "finger foo\ " or "finger 'foo "
2009-12-02 21:12:40 +01:00
# @param list $filters (optional) List of filters to apply to this function to tweak
# the expected completions and argument-to-complete. Possible values:
# - "ltrim_colon_completions"
2009-06-09 22:49:53 +02:00
# @result boolean True if successful, False if not
2009-12-02 21:12:40 +01:00
proc assert_complete {expected cmd {test ""} {prompt /@} {size 20} {cword ""} {filters ""}} {
2010-01-29 23:23:30 +01:00
if {[llength $expected] == 0} {
assert_no_complete $cmd $test
2009-06-14 12:18:24 +02:00
} else {
2010-01-29 23:23:30 +01:00
if {$test == ""} {set test "$cmd should show completions"}
send "$cmd\t"
2009-06-14 12:18:24 +02:00
if {[llength $expected] == 1} {
2010-01-29 23:23:30 +01:00
expect -ex "$cmd"
if {[lsearch -exact $filters "ltrim_colon_completions"] == -1} {
set cur ""; # Default to empty word to complete on
set words [split_words_bash $cmd]
if {[llength $words] > 1} {
# Assume last word of `$cmd' is word to complete on.
set index [expr [llength $words] - 1]
set cur [lindex $words $index]
}; # if
# Remove second word from beginning of single item $expected
if {[string first $cur $expected] == 0} {
set expected [list [string range $expected [string length $cur] end]]
}; # if
}; # if
2009-06-14 12:18:24 +02:00
} else {
2010-01-29 23:23:30 +01:00
expect -ex "$cmd\r\n"
# Make sure expected items are unique
set expected [lsort -unique $expected]
}; # if
if {[lsearch -exact $filters "ltrim_colon_completions"] != -1} {
# If partial contains colon (:), remove partial from begin of items
# See also: bash_completion.__ltrim_colon_completions()
_ltrim_colon_completions cword expected
}; # if
2009-11-07 09:57:11 +01:00
2010-01-29 23:23:30 +01:00
if {[match_items $expected $test $prompt $size]} {
if {[llength $expected] == 1} {
pass "$test"
2009-12-02 21:12:40 +01:00
} else {
2010-01-29 23:23:30 +01:00
# Remove optional (partial) last argument-to-complete from `cmd',
# E.g. "finger test@" becomes "finger"
if {[lsearch -exact $filters "ltrim_colon_completions"] != -1} {
set cmd2 $cmd
} else {
set cmd2 [_remove_cword_from_cmd $cmd $cword]
}; # if
# Determine common prefix of completions
set common [::textutil::string::longestCommonPrefixList $expected]
#if {[string length $common] > 0} {set common " $common"}
expect {
-ex "$prompt$cmd2$common" { pass "$test" }
-re $prompt { unresolved "$test at prompt" }
-re eof { unresolved "eof" }
}; # expect
2009-12-02 21:12:40 +01:00
}; # if
2010-01-29 23:23:30 +01:00
} else {
fail "$test"
2009-06-14 12:18:24 +02:00
}; # if
2009-06-09 22:49:53 +02:00
}; # if
}; # assert_complete()
2009-11-07 09:57:11 +01:00
# @param string $cmd Command to remove cword from
# @param string $cword (optional) Last argument of $cmd which is an
# argument-to-complete and to be deleted. If empty string (default),
# `_remove_cword_from_cmd' autodetects if the last argument is an
# argument-to-complete by checking if $cmd doesn't end with whitespace.
# Specifying `cword' is only necessary if this autodetection fails, e.g.
# when the last whitespace is escaped or quoted, e.g. "finger foo\ " or
# "finger 'foo "
# @return string Command with cword removed
proc _remove_cword_from_cmd {cmd {cword ""}} {
set cmd2 $cmd
# Is $cword specified?
if {[string length $cword] > 0} {
# Remove $cword from end of $cmd
if {[string last $cword $cmd] == [string length $cmd] - [string length $cword]} {
set cmd2 [string range $cmd 0 [expr [string last $cword $cmd] - 1]]
}; # if
} else {
# No, $cword not specified;
# Check if last argument is really an-argument-to-complete, i.e.
# doesn't end with whitespace.
# NOTE: This check fails if trailing whitespace is escaped or quoted,
# e.g. "finger foo\ " or "finger 'foo ". Specify parameter
# $cword in those cases.
# Is last char whitespace?
if {! [string is space [string range $cmd end end]]} {
# No, last char isn't whitespace;
# Remove argument-to-complete from end of $cmd
set cmd2 [lrange [split $cmd] 0 end-1]
append cmd2 " "
}; # if
}; # if
return $cmd2
}; # _remove_cword_from_cmd()
2010-01-29 23:23:30 +01:00
# Escape regexp special characters
proc _escape_regexp_chars {var} {
upvar $var str
regsub -all {([\^$+*?.|(){}[\]\\])} $str {\\\1} str
}
2009-06-14 16:22:25 +02:00
# Make sure any completions are returned
proc assert_complete_any {cmd {test ""} {prompt /@}} {
if {$test == ""} {set test "$cmd should show completions"}
send "$cmd\t"
expect -ex "$cmd"
2010-01-29 23:23:30 +01:00
_escape_regexp_chars cmd
2009-06-14 16:22:25 +02:00
expect {
2009-07-18 16:55:23 +02:00
-timeout 1
# Match completions, multiple words
2009-07-17 23:15:15 +02:00
# NOTE: The `\S*' (zero or more non-whitespace characters) matches a
2009-07-18 16:55:23 +02:00
# longest common prefix of the completions shown.
2009-07-17 23:15:15 +02:00
# E.g. `fmt -' becomes `fmt --' (two dashes) when completing
-re "^\r\n.*$prompt$cmd\\S*$" { pass "$test" }
2009-07-18 16:55:23 +02:00
timeout {
expect {
# Match completion, single word. This word is shown on the
# same line as the command.
-re "^\\w+ $" { pass "$test" }
# Try matching multiple words again, with new timeout
-re "^\r\n.*$prompt$cmd\\S*$" { pass "$test" }
}
}
2009-07-17 16:15:02 +02:00
-re $prompt { unresolved "$test at prompt" }
2009-07-18 16:55:23 +02:00
eof { unresolved "eof" }
2009-06-14 16:22:25 +02:00
}; # expect
}; # assert_complete_any()
2009-07-19 14:48:55 +02:00
# Make sure the expected files are returned by TAB-completing the
# specified command in the specified subdirectory.
# @param list $expected
# @param string $cmd Command given to generate items
# @param string $dir Subdirectory to attempt completion in. The directory must be relative from the $TESTDIR and without a trailing slash. E.g. `fixtures/evince'
2009-12-10 23:53:22 +02:00
# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions"
2009-07-19 14:48:55 +02:00
# @param string $prompt (optional) Bash prompt. Default is "/@"
# @param integer $size (optional) Chunk size. Default is 20.
2009-11-07 09:57:11 +01:00
# @param string $cword (optional) Last word of $cmd to complete. See: assert_complete()
2009-07-19 14:48:55 +02:00
# @result boolean True if successful, False if not
2009-11-07 09:57:11 +01:00
proc assert_complete_dir {expected cmd dir {test ""} {size 20} {cword ""}} {
2009-07-19 14:48:55 +02:00
set prompt "/$dir/@"
assert_bash_exec "cd $dir" "" $prompt
2009-11-07 09:57:11 +01:00
assert_complete $expected $cmd $test $prompt $size $cword
2009-07-19 14:48:55 +02:00
sync_after_int $prompt
assert_bash_exec "cd \$TESTDIR"
}; # assert_complete_dir
# Make sure a partial argument is completed.
# A completion is tried with `$partial', or if this is empty, the first
# character of the first item of `$expected'. Only the items from $expected,
# starting with this character are then expected as completions.
# @param list $expected List of all completions.
# @param string $cmd Command given to generate items
2009-11-07 09:57:11 +01:00
# @param string $partial Word to complete
2009-12-10 23:53:22 +02:00
# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions"
2009-07-19 14:48:55 +02:00
# @param string $prompt (optional) Bash prompt. Default is "/@"
# @param integer $size (optional) Chunk size. Default is 20.
2009-12-02 21:12:40 +01:00
# @param list $filters (optional) List of filters to apply to this function to tweak
# the expected completions and argument-to-complete.
# @see assert_complete()
2009-07-19 14:48:55 +02:00
# @result boolean True if successful, False if not
2009-12-02 21:12:40 +01:00
proc assert_complete_partial {expected cmd {partial ""} {test ""} {prompt /@} {size 20} {filters ""}} {
2009-07-19 14:48:55 +02:00
if {$test == ""} {set test "$cmd should complete partial argument"}
if {[llength $expected] == 0} {
unresolved "$test"
} else {
set pick {}
2009-11-29 14:40:46 +01:00
# Make sure expected items are unique
set expected [lsort -unique $expected]
2009-07-19 14:48:55 +02:00
foreach item $expected {
if {$partial == ""} {set partial [string range $item 0 0]}
# Only append item if starting with $partial
if {[string range $item 0 [expr [string length $partial] - 1]] == "$partial"} {
lappend pick $item
}; # if
}; # foreach
2009-12-02 21:12:40 +01:00
assert_complete $pick "$cmd $partial" $test $prompt $size $partial $filters
2009-07-19 14:48:55 +02:00
}; # if
}; # assert_complete_partial()
2009-12-02 21:12:40 +01:00
# See also: bash_completion._ltrim_colon_completions
proc _ltrim_colon_completions {cword items} {
upvar 1 $cword cword_out
upvar 1 $items items_out
# If word-to-complete contains a colon,
# and bash-version < 4,
# or bash-version >= 4 and COMP_WORDBREAKS contains a colon
if {
[string first : $cword_out] > -1 && (
2009-12-05 14:53:47 +01:00
[lindex $::BASH_VERSINFO 0] < 4 ||
([lindex $::BASH_VERSINFO 0] >= 4 && [string first ":" $::COMP_WORDBREAKS] > -1)
2009-12-02 21:12:40 +01:00
)
} {
for {set i 0} {$i < [llength $items_out]} {incr i} {
set item [lindex $items_out $i]
if {[string first $cword_out $item] == 0} {
# Strip colon-prefix
lset items_out $i [string range $item [string length $cword_out] end]
}; # if
}; # for
#set cword_out ""
}; # if
}; # _ltrim_colon_completions()
2009-06-09 22:49:53 +02:00
# Make sure the bash environment hasn't changed between now and the last call
# to `save_env()'.
# @param string $sed Sed commands to preprocess diff output.
2009-07-17 16:15:02 +02:00
# Example calls:
#
# # Replace `COMP_PATH=.*' with `COMP_PATH=PATH'
# assert_env_unmodified {s/COMP_PATH=.*/COMP_PATH=PATH/}
#
2009-07-31 12:20:51 +02:00
# # Remove lines containing `OLDPWD='
2009-07-17 16:15:02 +02:00
# assert_env_unmodified {/OLDPWD=/d}
#
2009-06-09 22:49:53 +02:00
# @param string $file Filename to generate environment save file from. See
# `gen_env_filename()'.
# @param string $diff Expected diff output (after being processed by $sed)
# @see save_env()
proc assert_env_unmodified {{sed ""} {file ""} {diff ""}} {
set test "Environment should not be modified"
_save_env [gen_env_filename $file 2]
# Prepare sed script
# Escape special bash characters ("\)
2009-09-20 13:07:04 +02:00
regsub -all {([\"\\])} $sed {\\\1} sed; #"# (fix Vim syntax highlighting)
2009-06-09 22:49:53 +02:00
# Escape newlines
regsub -all {\n} [string trim $sed] "\r\n" sed
# Prepare diff script
# If diff is filled, escape newlines and make sure it ends with a newline
if {[string length [string trim $diff]]} {
regsub -all {\n} [string trim $diff] "\r\n" diff
append diff "\r\n"
} else {
set diff ""
}; # if
# Execute diff
2009-09-16 22:14:53 +02:00
# NOTE: The dummy argument 'LAST-ARG' sets bash variable $_ (last argument) to
# 'LAST-ARG' so that $_ doesn't mess up the diff (as it would if $_
# was the (possibly multi-lined) sed script).
set cmd "diff_env \"[gen_env_filename $file 1]\" \"[gen_env_filename $file 2]\" \"$sed\" LAST-ARG"
2009-06-09 22:49:53 +02:00
send "$cmd\r"
2009-09-16 22:14:53 +02:00
expect "LAST-ARG\r\n"
2009-06-09 22:49:53 +02:00
expect {
-re "^$diff[wd]@$" { pass "$test" }
-re [wd]@ {
fail "$test"
# Show diff to user
set diff $expect_out(buffer)
# Remove possible `\r\n[wd]@' from end of diff
if {[string last "\r\n[wd]@" $diff] == [string length $diff] - [string length "\r\n[wd]@"]} {
set diff [string range $diff 0 [expr [string last "\r\n[wd]@" $diff] - 1]]
}; # if
send_user $diff;
}
}; # expect
}; # assert_env_unmodified()
# Make sure the specified command executed from within Tcl/Expect.
# Fail the test with status UNSUPPORTED if Tcl fails with error "POSIX/ENOENT
2010-01-30 14:56:39 +02:00
# (No such file or directory)", or with the given Tcl failure status command
# (default "unresolved") if other error occurs.
2009-06-09 22:49:53 +02:00
# NOTE: Further tests are assumed if executing the command is successful. The
# test isn't immediately declared to have PASSED if the command is
# executed successful.
# @param string $command
# @param string $stdout (optional) Reference to variable to hold stdout.
2009-12-10 23:53:22 +02:00
# @param string $test (optional) Test title
2010-01-30 14:56:39 +02:00
# @param string $failcmd (optional, default "unresolved") Failure command
2009-06-09 22:49:53 +02:00
# @see assert_bash_exec()
2010-01-30 14:56:39 +02:00
proc assert_exec {cmd {stdout ''} {test ''} {failcmd "unresolved"}} {
2010-01-14 20:19:35 +02:00
if {$test == ""} {set test "$cmd should execute successfully"}
2009-06-09 22:49:53 +02:00
upvar $stdout results
set status [catch {eval exec $cmd} results]
if {$status == 0} {
set result true
} else {
set result false
# Command not found (POSIX/ENOENT = no such file or directory)?
if {[lindex $::errorCode 0] == "POSIX" && [lindex $::errorCode 1] == "ENOENT"} {
# Yes, command not found;
# Indicate test is unsupported
unsupported "$test"
} else {
2010-01-30 14:56:39 +02:00
$failcmd "$test"
2009-06-09 22:49:53 +02:00
}; # if
}; # if
return $result
}; # assert_exec()
2010-01-29 23:23:30 +01:00
# Check that no completion is attempted on a certain command.
# Params:
# @cmd The command to attempt to complete.
# @test Optional parameter with test name.
proc assert_no_complete {{cmd} {test ""}} {
if {[string length $test] == 0} {
set test "$cmd shouldn't complete"
}; # if
send "$cmd\t"
expect -ex "$cmd"
# We can't anchor on $, simulate typing a magical string instead.
set endguard "Magic End Guard"
send "$endguard"
expect {
-re "^$endguard$" { pass "$test" }
default { fail "$test" }
timeout { fail "$test" }
}; # expect
}; # assert_no_complete()
2010-02-07 15:18:58 +01:00
# Check that no output is generated on a certain command.
# @param string $cmd The command to attempt to complete.
# @param string $test Optional parameter with test name.
# @param string $prompt (optional) Bash prompt. Default is "/@"
proc assert_no_output {{cmd} {test ""} {prompt /@}} {
if {[string length $test] == 0} {
set test "$cmd shouldn't generate output"
}
send "$cmd\r"
expect -ex "$cmd"
expect {
-re "^\r\n$prompt$" { pass "$test" }
default { fail "$test" }
timeout { fail "$test" }
}
}
2010-02-05 14:35:45 +01:00
# Source/run file with additional tests if completion for the specified command
# is installed in bash.
# @param string $command Command to check completion availability for.
# @param string $file (optional) File to source/run. Default is
# "lib/completions/$cmd.exp".
proc assert_source_completions {command {file ""}} {
if {[is_bash_completion_installed_for $command]} {
if {[string length $file] == 0} {
set file "lib/completions/$command.exp"
}
source $file
} else {
untested $command
}
}; # assert_source_completions()
2009-12-30 14:48:17 +01:00
# Sort list.
# `exec sort' is used instead of `lsort' to achieve exactly the
# same sort order as in bash.
# @param list $items
# @return list Sort list
proc bash_sort {items} {
return [split [exec sort << [join $items "\n"]] "\n"]
}; # bash_sort()
2010-01-24 10:32:41 +01:00
# Get 'known' hostnames. Looks also in ssh's 'known_hosts' files.
2010-02-05 08:45:44 +01:00
# @param string cword (optional) Word, hosts should start with.
2010-01-24 10:32:41 +01:00
# @return list Hostnames
# @see get_hosts()
2010-02-05 08:45:44 +01:00
proc get_known_hosts {{cword ''}} {
assert_bash_exec "_known_hosts_real '$cword'; echo_array COMPREPLY" \
{} /@ result
2010-01-24 10:32:41 +01:00
return $result
}; # get_known_hosts()
2009-07-19 14:48:55 +02:00
# Get hostnames
2009-06-19 14:56:36 +02:00
# @return list Hostnames
2010-01-24 10:32:41 +01:00
# @see get_known_hosts()
2009-06-19 14:56:36 +02:00
proc get_hosts {} {
set hosts [exec bash -c "compgen -A hostname"]
2009-08-18 21:28:43 +02:00
# NOTE: Circumventing var `avahi_hosts' and appending directly to `hosts'
2009-07-17 23:15:15 +02:00
# causes an empty element to be inserted in `hosts'.
# -- FVu, Fri Jul 17 23:11:46 CEST 2009
2009-08-18 21:28:43 +02:00
set avahi_hosts [get_hosts_avahi]
2009-07-31 12:20:51 +02:00
if {[llength $avahi_hosts] > 0} {
2009-07-17 23:15:15 +02:00
lappend hosts $avahi_hosts
}; # if
2009-11-25 22:31:29 +01:00
return $hosts
2009-06-19 14:56:36 +02:00
}; # get_hosts()
2009-08-18 21:28:43 +02:00
# Get hostnames according to avahi
# @return list Hostnames
proc get_hosts_avahi {} {
2009-09-13 18:05:58 +02:00
# Retrieving hosts is successful?
if { [catch {exec bash -c {
2009-11-25 21:47:58 +01:00
type avahi-browse >&/dev/null \
2009-12-15 23:48:10 +02:00
&& avahi-browse -cpr _workstation._tcp 2>/dev/null | command grep ^= | cut -d\; -f7 | sort -u
2009-09-13 18:05:58 +02:00
}} hosts] } {
# No, retrieving hosts yields error;
# Reset hosts
set hosts {}
}; # if
2009-08-18 21:28:43 +02:00
return $hosts
}; # get_hosts_avahi()
2009-07-19 14:48:55 +02:00
# Get signals
# This function is written in analogy to the bash function `_signals()' in
# `bash_completion'.
# @return list Signals starting with `SIG', but with the `SIG' prefix removed.
proc get_signals {} {
set signals {}
foreach signal [exec bash -c {compgen -A signal}] {
# Does signal start with `SIG'?
if {[string range $signal 0 [expr [string length "SIG"] - 1]] == "SIG"} {
# Remove `SIG' prefix
set signal [string range $signal 3 end]
# Add signal (with dash (-) prefix) to list
lappend signals -$signal
}; # if
}; # foreach
return $signals
}; # get_signals()
2009-12-05 14:53:47 +01:00
# Initialize tcl globals with bash variables
proc init_tcl_bash_globals {} {
global BASH_VERSINFO BASH_VERSION COMP_WORDBREAKS
assert_bash_exec {printf "%s" "$COMP_WORDBREAKS"} {} /@ COMP_WORDBREAKS
assert_bash_exec {printf "%s " "${BASH_VERSINFO[@]}"} "" /@ BASH_VERSINFO
set BASH_VERSINFO [eval list $BASH_VERSINFO]
assert_bash_exec {printf "%s" "$BASH_VERSION"} "" /@ BASH_VERSION
assert_bash_exec {printf "%s" "$TESTDIR"} "" /@ TESTDIR
}; # init_tcl_bash_globals()
2010-02-05 14:35:45 +01:00
# Check whether completion is installed for the specified command by executing
# `complete -p ...' in bash.
# @param string $command Command to check completion availability for.
# @return boolean True (1) if completion is installed, False (0) if not.
proc is_bash_completion_installed_for {command} {
set test "$command should have completion installed in bash"
set cmd "complete -p $command &> /dev/null && echo -n 0 || echo -n 1"
send "$cmd\r"
expect "$cmd\r\n"
expect {
-ex 0 { set result true }
-ex 1 { set result false }
}
expect "/@"
return $result
}; # is_bash_completion_installed_for()
2009-12-30 14:48:17 +01:00
# Detect if test suite is running under Cygwin/Windows
proc is_cygwin {} {
expr {[string first [string tolower [exec uname -s]] cygwin] >= 0}
}; # is_cygwin()
2009-06-09 22:49:53 +02:00
# Expect items.
# Break items into chunks because `expect' seems to have a limited buffer size
# @param list $items
# @param integer $size Chunk size
# @result boolean True if successful, False if not
2009-12-24 09:41:22 +01:00
proc match_items {items test {prompt /@} {size 20}} {
2009-12-02 22:38:30 +01:00
set items [bash_sort $items]
2009-06-09 22:49:53 +02:00
set result false
for {set i 0} {$i < [llength $items]} {set i [expr {$i + $size}]} {
2010-01-16 12:56:29 +02:00
# For chunks > 1, allow leading whitespace
if {$i > $size} { set expected "\\s*" } else { set expected "" }
2009-06-09 22:49:53 +02:00
for {set j 0} {$j < $size && $i + $j < [llength $items]} {incr j} {
set item "[lindex $items [expr {$i + $j}]]"
2010-01-29 23:23:30 +01:00
_escape_regexp_chars item
2009-06-14 12:18:24 +02:00
append expected $item
2009-06-19 14:23:57 +02:00
if {[llength $items] > 1} {append expected {\s+}};
2009-06-09 22:49:53 +02:00
}; # for
2009-06-19 14:23:57 +02:00
if {[llength $items] == 1} {
expect {
2009-12-24 09:41:22 +01:00
-re "^$expected\r\n$" { set result true }
2009-10-04 18:18:29 +02:00
# NOTE: The optional space ( ?) depends on whether -o nospace is active
-re "^$expected ?$" { set result true }
2009-12-24 09:41:22 +01:00
-re "^$prompt$" {set result false; break }
2009-06-19 14:23:57 +02:00
"\r\n" { set result false; break }
default { set result false; break }
timeout { set result false; break }
}; # expect
} else {
expect {
2009-09-16 23:17:56 +02:00
-re "^$expected" { set result true }
2009-06-19 14:23:57 +02:00
default { set result false; break }
timeout { set result false; break }
}; # expect
}; # if
2009-06-09 22:49:53 +02:00
}; # for
return $result
}; # match_items()
# Get real command.
# - arg: $1 Command
# - return: Command found, empty string if not found
proc realcommand {cmd} {
set result ""
if [string length [set path [auto_execok $cmd]]] {
if {[string length [auto_execok realpath]]} {
set result [exec realpath $path]
} elseif {[string length [auto_execok readlink]]} {
set result [exec readlink -f $path]
} else {
set result $path
}; # if
}; # if
return $result
}; # realcommand()
# Generate filename to save environment to.
# @param string $file File-basename to save environment to. If the file has a
# `.exp' suffix, it is removed. E.g.:
# - "file.exp" becomes "file.env1~"
# - "" becomes "env.env1~"
# - "filename" becomes "filename.env1~"
# The file will be stored in the $TESTDIR/tmp directory.
# @param integer $seq Sequence number. Must be either 1 or 2.
proc gen_env_filename {{file ""} {seq 1}} {
if {[string length $file] == 0} {
set file "env"
} else {
# Remove possible directories
set file [file tail $file]
# Remove possible '.exp' suffix from filename
if {[string last ".exp" $file] == [string length $file] - [string length ".exp"]} {
set file [string range $file 0 [expr [string last ".exp" $file] - 1]]
}; # if
}; # if
return "\$TESTDIR/tmp/$file.env$seq~"
}; # gen_env_filename()
# Save the environment for later comparison
# @param string $file Filename to generate environment save file from. See
# `gen_env_filename()'.
proc save_env {{file ""}} {
_save_env [gen_env_filename $file 1]
}; # save_env()
# Save the environment for later comparison
# @param string File to save the environment to. Default is "$TESTDIR/tmp/env1~".
# @see assert_env_unmodified()
proc _save_env {{file ""}} {
2010-01-28 00:34:20 +02:00
assert_bash_exec "{ set; declare -F; shopt -p; } > $file"
}; # _save_env()
2009-06-09 22:49:53 +02:00
2009-12-05 14:53:47 +01:00
# Source bash_completion package
proc source_bash_completion {} {
assert_bash_exec {BASH_COMPLETION_DIR=$(cd $TESTDIR/..; pwd)/contrib}
2009-12-29 23:07:06 +01:00
assert_bash_exec {BASH_COMPLETION_COMPAT_DIR=$BASH_COMPLETION_DIR}
2009-12-05 14:53:47 +01:00
assert_bash_exec {BASH_COMPLETION=$(cd $TESTDIR/..; pwd)/bash_completion}
assert_bash_exec {source $BASH_COMPLETION}
}; # source_bash_completion()
2010-01-29 23:23:30 +01:00
# Split line into words, disregarding backslash escapes (e.g. \b (backspace),
# \g (bell)), but taking backslashed spaces into account.
# Aimed for simulating bash word splitting.
# Example usage:
#
# % set a {f cd\ \be}
# % split_words $a
# f {cd\ \be}
#
# @param string Line to split
# @return list Words
proc split_words_bash {line} {
set words {}
set glue false
foreach part [split $line] {
set glue_next false
# Does `part' end with a backslash (\)?
if {[string last "\\" $part] == [string length $part] - [string length "\\"]} {
# Remove end backslash
set part [string range $part 0 [expr [string length $part] - [string length "\\"] - 1]]
# Indicate glue on next run
set glue_next true
}; # if
# Must `part' be appended to latest word (= glue)?
if {[llength $words] > 0 && [string is true $glue]} {
# Yes, join `part' to latest word;
set zz [lindex $words [expr [llength $words] - 1]]
# Separate glue with backslash-space (\ );
lset words [expr [llength $words] - 1] "$zz\\ $part"
} else {
# No, don't append word to latest word;
# Append `part' as separate word
lappend words $part
}; # if
set glue $glue_next
}; # foreach
return $words
}; # split_words_bash()
2009-12-05 14:53:47 +01:00
# Start bash running as test environment.
proc start_bash {} {
global TESTDIR TOOL_EXECUTABLE spawn_id
set TESTDIR [pwd]
# If `--tool_exec' option not specified, use "bash"
if {! [info exists TOOL_EXECUTABLE]} {set TOOL_EXECUTABLE bash}
exp_spawn $TOOL_EXECUTABLE --rcfile config/bashrc
assert_bash_exec {} "$TOOL_EXECUTABLE --rcfile config/bashrc"
# Bash < 3.2.41 has a bug where 'history' disappears from SHELLOPTS
# whenever a shopt setting is sourced or eval'ed. Disabling 'history'
# makes it not show in tests "Environment should not be modified"
# for bash < 3.2.41.
# -- FVu, Tue Sep 15 22:52:00 CEST 2009
assert_bash_exec {is_bash_version_minimal 3 2 41 || set +o history}
}; # start_bash()
2009-06-09 22:49:53 +02:00
# Interrupt completion and sync with prompt.
# Send signals QUIT & INT.
2009-07-17 16:15:02 +02:00
# @param string $prompt (optional) Bash prompt. Default is "/@"
proc sync_after_int {{prompt /@}} {
2009-06-09 22:49:53 +02:00
set test "Sync after INT"
sleep .1
send \031\003; # QUIT/INT
2009-07-19 14:48:55 +02:00
# NOTE: Regexp `.*' causes `expect' to discard previous unknown output.
# This is necessary if a completion doesn't match expectations.
2009-11-07 09:57:11 +01:00
# For instance with `filetype_xspec' completion (e.g. `kdvi') if
2009-07-19 14:48:55 +02:00
# one expects `.txt' as a completion (wrong, because it isn't
# there), the unmatched completions need to be cleaned up.
expect -re ".*$prompt$"
2009-06-09 22:49:53 +02:00
}; # sync_after_int()
proc sync_after_tab {} {
# NOTE: Wait in case completion returns nothing - because `units' isn't
# installed, so that "^$cdm.*$" doesn't match too early - before
# comp_install has finished
sleep .4
}; # sync_after_tab()
# Return current working directory with `TESTDIR' stripped
# @return string Working directory. E.g. /, or /fixtures/
proc wd {} {
global TESTDIR
# Remove `$TESTDIR' prefix from current working directory
set wd [string replace [pwd] 0 [expr [string length $TESTDIR] - 1]]/
2009-09-20 13:07:04 +02:00
}; # wd()