# 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 {[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} { # Is DejaGnu fully initialized, i.e. is "fail" method available? if {[info exists multipass_name]} { fail "ERROR Unexpected output from bash command \"$title\"" } send_user "ERROR Unexpected output from bash command \"$title\":\n$results" } set cmd "echo $?" send "$cmd\r" expect { -ex "$cmd\r\n0\r\n$prompt" {} $prompt { # Is DejaGnu fully initialized, i.e. is "fail" method available? if {[info exists multipass_name]} { fail "ERROR executing bash command \"$title\"" } send_user "ERROR executing bash command \"$title\"" } } } # 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 "/@" return $result } # 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 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"} } # 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 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] } # 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]] } } } else { expect -ex "$cmd\r\n" # Make sure expected items are unique set expected [lsort -unique $expected] } 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 {[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] } # 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" } } } } else { fail "$test" } } } # @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]] } } 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 " " } } return $cmd2 } # 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" } } } # 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 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"} } # 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 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 } } assert_complete $pick "$cmd $partial" $test $prompt $size $partial $filters } } # 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] } } #set cword_out "" } } # 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 "" } # 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]] } send_user $diff; } } } # 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" } } return $result } # 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" } 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" } } } # 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 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 } return $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 {} } return $hosts } # 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 } } return $signals } # Initialize tcl globals with bash variables proc init_tcl_bash_globals {} { global BASH_VERSINFO BASH_VERSION COMP_WORDBREAKS LC_CTYPE 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 assert_bash_exec {eval $(locale); printf "%s" "$LC_CTYPE"} "" /@ LC_CTYPE } # 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 } # Detect if test suite is running under Cygwin/Windows proc is_cygwin {} { expr {[string first [string tolower [exec uname -s]] cygwin] >= 0} } # 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+}}; } 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 } } } else { expect { -re "^$expected" { set result true } default { set result false; break } timeout { set result false; break } } } } return $result } # 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 } } return $result } # 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]] } } return "\$TESTDIR/tmp/$file.env$seq~" } # 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 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\"" } # Source bash_completion package proc source_bash_completion {} { assert_bash_exec {BASH_COMPLETION_DIR=$(cd "$TESTDIR/.."; pwd)/completions} 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"} } # 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 } # 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 } set glue $glue_next } return $words } # 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} } # 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 } # 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]]/ }