# 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 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"} send "$cmd\r" expect -ex "$cmd\r\n" if {[match_items $expected $test $prompt $size]} { expect { -re $prompt { pass "$test" } -re eof { unresolved "eof" } }; # expect } else { fail "$test" }; # if }; # assert_bash_list() 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 # @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' is only 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 {$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 cmds [split $cmd] set cur ""; # Default to empty word to complete on if {[llength $cmds] > 1} { # Assume last word of `$cmd' is word to complete on. set cur [lindex $cmds [expr [llength $cmds] - 1]] }; # if # Remove second word from beginning of single item $expected if {[string first $cur $expected] == 0} { set expected [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 }; # 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() # 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 special regexp characters regsub -all {([\^$+*?.|(){}[\]\\])} $cmd {\\\1} 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 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 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 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 # @see assert_bash_exec() proc assert_exec {cmd {stdout ''} {test ''}} { 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 { unresolved "$test" }; # if }; # if return $result }; # assert_exec() # 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() # Get 'known' hostnames. Looks also in ssh's 'known_hosts' files. # @return list Hostnames # @see get_hosts() proc get_known_hosts {} { assert_bash_exec {_known_hosts_real ''; 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() # 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 special regexp characters regsub -all {([\^$+*?.|(){}[\]\\])} $item {\\\1} 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; } > $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() # 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() # 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 # 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$" }; # 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]]/ }; # wd()