diff options
Diffstat (limited to 'test/lib/library.exp')
| -rw-r--r-- | test/lib/library.exp | 908 |
1 files changed, 908 insertions, 0 deletions
diff --git a/test/lib/library.exp b/test/lib/library.exp new file mode 100644 index 00000000..c76d9854 --- /dev/null +++ b/test/lib/library.exp @@ -0,0 +1,908 @@ + # 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 + + + +# Execute a bash command and make sure the exit status is successful. +# If not, output the error message. +# @param string $cmd Bash command line to execute. If empty string (""), the +# 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. +# @param string $prompt (optional) Bash prompt. Default is "/@" +# @param mixed $out (optional) Reference to (tcl) variable to hold output. +# 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} + if {[string length $aCmd] != 0} { + send "$aCmd\r" + expect -ex "$aCmd\r\n" + }; # if + if {[string length $title] == 0} {set title $aCmd} + expect -ex $prompt + set results $expect_out(buffer); # Catch output + # Remove $prompt suffix from output + set results [ + string range $results 0 [ + expr [string length $results] - [string length $prompt] - 1 + ] + ] + 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 + + set cmd "echo $?" + send "$cmd\r" + expect { + -ex "$cmd\r\n0\r\n$prompt" {} + $prompt { + if {[info exists multipass_name]} { + fail "ERROR executing bash command \"$title\"" + }; # if + send_user "ERROR executing bash command \"$title\"" + } + }; # 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() + + +# Make sure the expected list is returned by executing the specified command. +# @param list $expected +# @param string $cmd Command given to generate items +# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions" +# @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"} + if {[llength $expected] == 0} { + assert_no_output $cmd $test $prompt + } else { + 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" + } + } +} + + +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() + + +# Make sure the expected items are returned by TAB-completing the specified +# command. +# @param list $expected Expected completions. +# @param string $cmd Command given to generate items +# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions" +# @param string $prompt (optional) Bash prompt. Default is "/@" +# @param integer $size (optional) Chunk size. Default is 20. +# @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 +# doesn't end with whitespace. Specifying `cword' should only be necessary +# if this autodetection fails, e.g. when the last whitespace is escaped or +# quoted, e.g. "finger foo\ " or "finger 'foo " +# @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" +# @result boolean True if successful, False if not +proc assert_complete {expected cmd {test ""} {prompt /@} {size 20} {cword ""} {filters ""}} { + if {[llength $expected] == 0} { + assert_no_complete $cmd $test + } else { + if {$test == ""} {set test "$cmd should show completions"} + send "$cmd\t" + if {[llength $expected] == 1} { + 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 + } else { + 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 + + if {[match_items $expected $test $prompt $size]} { + if {[llength $expected] == 1} { + pass "$test" + } else { + # 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 + }; # if + } else { + fail "$test" + }; # if + }; # if +}; # assert_complete() + + +# @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() + + +# Escape regexp special characters +proc _escape_regexp_chars {var} { + upvar $var str + regsub -all {([\^$+*?.|(){}[\]\\])} $str {\\\1} str +} + +# 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" + _escape_regexp_chars cmd + expect { + -timeout 1 + # Match completions, multiple words + # NOTE: The `\S*' (zero or more non-whitespace characters) matches a + # longest common prefix of the completions shown. + # E.g. `fmt -' becomes `fmt --' (two dashes) when completing + -re "^\r\n.*$prompt$cmd\\S*$" { pass "$test" } + 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" } + } + } + -re $prompt { unresolved "$test at prompt" } + eof { unresolved "eof" } + }; # expect +}; # assert_complete_any() + + +# 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' +# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions" +# @param string $prompt (optional) Bash prompt. Default is "/@" +# @param integer $size (optional) Chunk size. Default is 20. +# @param string $cword (optional) Last word of $cmd to complete. See: assert_complete() +# @result boolean True if successful, False if not +proc assert_complete_dir {expected cmd dir {test ""} {size 20} {cword ""}} { + set prompt "/$dir/@" + assert_bash_exec "cd $dir" "" $prompt + assert_complete $expected $cmd $test $prompt $size $cword + 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 +# @param string $partial Word to complete +# @param string $test (optional) Test title. Default is "$cmd<TAB> should show completions" +# @param string $prompt (optional) Bash prompt. Default is "/@" +# @param integer $size (optional) Chunk size. Default is 20. +# @param list $filters (optional) List of filters to apply to this function to tweak +# the expected completions and argument-to-complete. +# @see assert_complete() +# @result boolean True if successful, False if not +proc assert_complete_partial {expected cmd {partial ""} {test ""} {prompt /@} {size 20} {filters ""}} { + if {$test == ""} {set test "$cmd should complete partial argument"} + if {[llength $expected] == 0} { + unresolved "$test" + } else { + set pick {} + # Make sure expected items are unique + set expected [lsort -unique $expected] + 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 + assert_complete $pick "$cmd $partial" $test $prompt $size $partial $filters + }; # if +}; # assert_complete_partial() + + +# 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 && ( + [lindex $::BASH_VERSINFO 0] < 4 || + ([lindex $::BASH_VERSINFO 0] >= 4 && [string first ":" $::COMP_WORDBREAKS] > -1) + ) + } { + 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() + + +# 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. +# Example calls: +# +# # Replace `COMP_PATH=.*' with `COMP_PATH=PATH' +# assert_env_unmodified {s/COMP_PATH=.*/COMP_PATH=PATH/} +# +# # Remove lines containing `OLDPWD=' +# assert_env_unmodified {/OLDPWD=/d} +# +# @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 ("\) + regsub -all {([\"\\])} $sed {\\\1} sed; #"# (fix Vim syntax highlighting) + # 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 + + # 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" + send "$cmd\r" + expect "LAST-ARG\r\n" + + 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 +# (No such file or directory)", or with the given Tcl failure status command +# (default "unresolved") if other error occurs. +# 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. +# @param string $test (optional) Test title +# @param string $failcmd (optional, default "unresolved") Failure command +# @see assert_bash_exec() +proc assert_exec {cmd {stdout ''} {test ''} {failcmd "unresolved"}} { + if {$test == ""} {set test "$cmd should execute successfully"} + 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 { + $failcmd "$test" + }; # if + }; # if + return $result +}; # assert_exec() + + +# 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() + + +# 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" } + } +} + + +# 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 + } +} + + +# 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"] +} + + +# Get 'known' hostnames. Looks also in ssh's 'known_hosts' files. +# @param string cword (optional) Word, hosts should start with. +# @return list Hostnames +# @see get_hosts() +proc get_known_hosts {{cword ''}} { + assert_bash_exec "_known_hosts_real '$cword'; echo_array COMPREPLY" \ + {} /@ result + return $result +}; # get_known_hosts() + + +# Get hostnames +# @return list Hostnames +# @see get_known_hosts() +proc get_hosts {} { + set hosts [exec bash -c "compgen -A hostname"] + # NOTE: Circumventing var `avahi_hosts' and appending directly to `hosts' + # causes an empty element to be inserted in `hosts'. + # -- FVu, Fri Jul 17 23:11:46 CEST 2009 + set avahi_hosts [get_hosts_avahi] + if {[llength $avahi_hosts] > 0} { + lappend hosts $avahi_hosts + }; # if + return $hosts +}; # get_hosts() + + +# Get hostnames according to avahi +# @return list Hostnames +proc get_hosts_avahi {} { + # Retrieving hosts is successful? + if { [catch {exec bash -c { + type avahi-browse >&/dev/null \ + && avahi-browse -cpr _workstation._tcp 2>/dev/null | command grep ^= | cut -d\; -f7 | sort -u + }} hosts] } { + # No, retrieving hosts yields error; + # Reset hosts + set hosts {} + }; # if + return $hosts +}; # get_hosts_avahi() + + +# 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() + + +# 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() + + +# 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() + + +# Detect if test suite is running under Cygwin/Windows +proc is_cygwin {} { + expr {[string first [string tolower [exec uname -s]] cygwin] >= 0} +}; # is_cygwin() + + +# 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 +proc match_items {items test {prompt /@} {size 20}} { + set items [bash_sort $items] + set result false + for {set i 0} {$i < [llength $items]} {set i [expr {$i + $size}]} { + # For chunks > 1, allow leading whitespace + if {$i > $size} { set expected "\\s*" } else { set expected "" } + for {set j 0} {$j < $size && $i + $j < [llength $items]} {incr j} { + set item "[lindex $items [expr {$i + $j}]]" + _escape_regexp_chars item + append expected $item + if {[llength $items] > 1} {append expected {\s+}}; + }; # for + if {[llength $items] == 1} { + expect { + -re "^$expected\r\n$" { set result true } + # NOTE: The optional space ( ?) depends on whether -o nospace is active + -re "^$expected ?$" { set result true } + -re "^$prompt$" {set result false; break } + "\r\n" { set result false; break } + default { set result false; break } + timeout { set result false; break } + }; # expect + } else { + expect { + -re "^$expected" { set result true } + default { set result false; break } + timeout { set result false; break } + }; # expect + }; # if + }; # 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 ""}} { + assert_bash_exec "{ set; declare -F; shopt -p; } > \"$file\"" +}; # _save_env() + + +# Source bash_completion package +proc source_bash_completion {} { + assert_bash_exec {BASH_COMPLETION_DIR=$(cd "$TESTDIR/.."; pwd)/contrib} + assert_bash_exec {BASH_COMPLETION_COMPAT_DIR=$BASH_COMPLETION_DIR} + assert_bash_exec {BASH_COMPLETION=$(cd "$TESTDIR/.."; pwd)/bash_completion} + assert_bash_exec {source "$BASH_COMPLETION"} +}; # source_bash_completion() + + +# 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() + + +# Given a list of items this proc finds a (part, full) pair so that when +# completing from $part $full will be the only option. +# +# Arguments: +# list The list of full completions. +# partName Output parameter for the partial string. +# fullName Output parameter for the full string, member of item. +# +# Results: +# 1, or 0 if no suitable result was found. +proc find_unique_completion_pair {{list} {partName} {fullName}} { + upvar $partName part + upvar $fullName full + set bestscore 0 + set list [lsort $list] + set n [llength $list] + for {set i 0} {$i < $n} {incr i} { + set cur [lindex $list $i] + set curlen [string length $cur] + + set prev [lindex $list [expr {$i - 1}]] + set next [lindex $list [expr {$i + 1}]] + set diffprev [expr {$prev == ""}] + set diffnext [expr {$next == ""}] + + # Analyse each item of the list and look for the minimum length of the + # partial prefix which is distinct from both $next and $prev. The list + # is sorted so the prefix will be unique in the entire list. + # + # In the worst case we analyse every character in the list 3 times. + # That's actually very fast, sorting could take more. + for {set j 0} {$j < $curlen} {incr j} { + set curchar [string index $cur $j] + if {!$diffprev && [string index $prev $j] != $curchar} { + set diffprev 1 + } + if {!$diffnext && [string index $next $j] != $curchar} { + set diffnext 1 + } + if {$diffnext && $diffprev} { + break + } + } + + # At the end of the loop $j is the index of last character of + # the unique partial prefix. The length is one plus that. + set parlen [expr {$j + 1}] + if {$parlen >= $curlen} { + continue + } + + # Try to find the most "readable pair"; look for a long pair where + # $part is about half of $full. + if {$parlen < $curlen / 2} { + set parlen [expr {$curlen / 2}] + } + set score [expr {$curlen - $parlen}] + if {$score > $bestscore} { + set bestscore $score + set part [string range $cur 0 [expr {$parlen - 1}]] + set full $cur + } + } + return [expr {$bestscore != 0}] +} + + +# 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() + + +# Redirect xtrace output to a file. +# +# 'set -x' can be very useful for debugging but by default it writes to +# stderr. Bash 4.1 has a feature to redirect this output to a random FD. +# +# This function uses file descriptor 6. This will break if any completion +# tries to use the same descriptor. +proc init_bash_xtrace {{fname xtrace.log}} { + global BASH_VERSINFO + if {([lindex $BASH_VERSINFO 0] == 4 && [lindex $BASH_VERSINFO 1] < 1) || + [lindex $BASH_VERSINFO 0] < 4} { + note "BASH_XTRACEFD not available in this version; no xtrace.log" + return + } + verbose "Enabling bash xtrace output to '$fname'" + assert_bash_exec "exec 6>'$fname'" + assert_bash_exec "BASH_XTRACEFD=6" + assert_bash_exec "set -o xtrace" +} + + +# Setup test environment +# +# Common initialization for unit and completion tests. +proc start_interactive_test {} { + start_bash + source_bash_completion + init_tcl_bash_globals + + global OPT_BASH_XTRACE + if {[info exists OPT_BASH_XTRACE]} { + init_bash_xtrace + } + global OPT_TIMEOUT + if {[info exists OPT_TIMEOUT]} { + global timeout + verbose "Changing default expect timeout from $timeout to $OPT_TIMEOUT" + set timeout $OPT_TIMEOUT + } +} + + +# Interrupt completion and sync with prompt. +# Send signals QUIT & INT. +# @param string $prompt (optional) Bash prompt. Default is "/@" +proc sync_after_int {{prompt /@}} { + set test "Sync after INT" + sleep .1 + send \031\003; # QUIT/INT + # Wait to allow bash to become ready + # See also: http://lists.alioth.debian.org/pipermail/bash-completion-devel/ + # 2010-February/002566.html + sleep .1 + # NOTE: Regexp `.*' causes `expect' to discard previous unknown output. + # This is necessary if a completion doesn't match expectations. + # For instance with `filetype_xspec' completion (e.g. `kdvi') if + # one expects `.txt' as a completion (wrong, because it isn't + # there), the unmatched completions need to be cleaned up. + expect -re ".*$prompt$" +} + + +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]]/ +}; # wd() |