diff options
Diffstat (limited to 'test/lib/library.exp')
| -rw-r--r-- | test/lib/library.exp | 970 |
1 files changed, 0 insertions, 970 deletions
diff --git a/test/lib/library.exp b/test/lib/library.exp deleted file mode 100644 index c90c927c..00000000 --- a/test/lib/library.exp +++ /dev/null @@ -1,970 +0,0 @@ -# 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 cmdline -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} { - fail "ERROR Unexpected output from bash command \"$title\"" - } - - set cmd "echo $?" - send "$cmd\r" - expect { - -ex "$cmd\r\n0\r\n$prompt" {} - $prompt {fail "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 matches the real list, as returned by executing -# the specified bash command. -# Specify `-sort' if the real list is sorted. -# @param list $expected Expected list items -# @param string $cmd Bash command to execute in order to generate real list -# items -# @param string $test Test title. Becomes "$cmd should show expected output" -# if empty string. -# @param list $args Options: -# -sort Compare list sorted. Default is unsorted -# -prompt Bash prompt. Default is `/@' -# -chunk-size N Compare list N items at a time. Default -# is 20. -proc assert_bash_list {expected cmd test {args {}}} { - array set arg [::cmdline::getoptions args { - {sort "compare list sorted"} - {prompt.arg /@ "bash prompt"} - {chunk-size.arg 20 "compare N list items at a time"} - }] - set prompt $arg(prompt) - 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 {$arg(sort)} {set bash_sort "-bash-sort"} {set bash_sort ""} - if {[ - eval match_items \$expected $bash_sort -chunk-size \ - \$arg(chunk-size) -end-newline -end-prompt \ - -prompt \$prompt - ]} { - pass "$test" - } else { - fail "$test" - } - } -} - - -# Make sure the expected list matches the real list, as returned by executing -# the specified bash command within the specified directory. -# Specify `-sort' if the real list is sorted. -# @param list $expected Expected list items -# @param string $cmd Bash command to generate real list items -# @param string $dir Directory to execute $cmd within -# @param string $test Test title. Becomes "$cmd should show expected output" -# if empty string. -# @param list $args Options: -# -sort Compare list sorted. Default is unsorted -# -prompt Bash prompt. Default is `/@' -# -chunk-size N Compare list N items at a time. Default -# is 20. -proc assert_bash_list_dir {expected cmd dir test {args {}}} { - array set arg [::cmdline::getoptions args { - {sort "compare list sorted"} - {prompt.arg "/@" "bash prompt"} - {chunk-size.arg 20 "compare N list items at a time"} - }] - set prompt $arg(prompt) - if {$arg(sort)} {set arg_sort "-sort"} else {set arg_sort ""} - assert_bash_exec "cd $dir" "" $prompt - assert_bash_list $expected $cmd $test $arg_sort \ - -chunk-size $arg(chunk-size) -prompt $prompt - sync_after_int $prompt - assert_bash_exec {cd "$TESTDIR"} -} - - -# Make sure the expected items are returned by TAB-completing the specified -# command. If the number of expected items is one, expected is: -# -# $cmd<TAB>$expected[<SPACE>] -# -# SPACE is not expected if -nospace is specified. -# -# If the number of expected items is greater than one, expected is: -# -# $cmd<TAB>\n -# $expected\n -# $prompt + ($cmd - AUTO) + longest-common-prefix-of-$expected -# -# AUTO is calculated like this: If $cmd ends with non-whitespace, and -# the last argument of $cmd equals the longest-common-prefix of -# $expected, $cmd minus this argument will be expected. -# -# If the algorithm above fails, you can manually specify the CWORD to be -# subtracted from $cmd specifying `-expect-cmd-minus CWORD'. Known cases where -# this is useful are when: -# - the last whitespace is escaped, e.g. "finger foo\ " or "finger -# 'foo " -# -# @param list $expected Expected completions. -# @param string $cmd Command given to generate items -# @param string $test Test title -# @param list $args Options: -# -prompt PROMPT Bash prompt. Default is `/@' -# -chunk-size CHUNK-SIZE Compare list CHUNK-SIZE items at -# a time. Default is 20. -# -nospace Don't expect space character to be output after completion match. -# Valid only if a single completion is expected. -# -ltrim-colon-completions Left-trim completions with cword containing -# colon (:) -# -expect-cmd-minus DWORD Expect $cmd minus DWORD to be echoed. -# Expected is: -# -# $cmd<TAB>\n -# $expected\n -# $prompt + ($cmd - DWORD) + longest-common-prefix-of-$expected -# -proc assert_complete {expected cmd {test ""} {args {}}} { - set args_orig $args - array set arg [::cmdline::getoptions args { - {prompt.arg "/@" "bash prompt"} - {chunk-size.arg 20 "compare N list items at a time"} - {nospace "don't expect space after completion"} - {ltrim-colon-completions "left-trim completions with cword containing :"} - {expect-cmd-minus.arg "" "Expect cmd minus DWORD after prompt"} - }] - if {[llength $expected] == 0} { - assert_no_complete $cmd $test - } elseif {[llength $expected] == 1} { - eval assert_complete_one \$expected \$cmd \$test $args_orig - } else { - eval assert_complete_many \$expected \$cmd \$test $args_orig - } -} - - -# Make sure the expected multiple items are returned by TAB-completing the -# specified command. -# @see assert_complete() -proc assert_complete_many {expected cmd {test ""} {args {}}} { - array set arg [::cmdline::getoptions args { - {prompt.arg "/@" "bash prompt"} - {chunk-size.arg 20 "compare N list items at a time"} - {nospace "don't expect space after completion"} - {ltrim-colon-completions "left-trim completions with cword containing :"} - {expect-cmd-minus.arg "" "Expect cmd minus CWORD after prompt"} - }] - if {$test == ""} {set test "$cmd should show completions"} - set prompt $arg(prompt) - set dword "" - if {$arg(expect-cmd-minus) != ""} {set dword $arg(expect-cmd-minus)} - - send "$cmd\t" - expect -ex "$cmd\r\n" - - # Make sure expected items are unique - set expected [lsort -unique $expected] - - # Determine common prefix of completions - set common [::textutil::string::longestCommonPrefixList $expected] - - if {$arg(ltrim-colon-completions)} { - # If partial contains colon (:), remove partial from begin of items - _ltrim_colon_completions $cmd expected dword - } - set cmd2 [_remove_cword_from_cmd $cmd $dword $common] - - set prompt "$prompt$cmd2$common" - if {$arg(nospace)} {set endspace ""} else {set endspace "-end-space"} - set endprompt "-end-prompt" - if {[ - eval match_items \$expected -bash-sort -chunk-size \ - \$arg(chunk-size) $endprompt $endspace -prompt \$prompt - ]} { - pass "$test" - } else { - fail "$test" - } -} - - -# Make sure the expected single item is returned by TAB-completing the -# specified command. -# @see assert_complete() -proc assert_complete_one {expected cmd {test ""} {args {}}} { - array set arg [::cmdline::getoptions args { - {prompt.arg "/@" "bash prompt"} - {chunk-size.arg 20 "compare N list items at a time"} - {nospace "don't expect space after completion"} - {ltrim-colon-completions "left-trim completions with cword containing :"} - {expect-cmd-minus.arg "" "Expect cmd minus CWORD after prompt"} - }] - set prompt $arg(prompt) - - if {$test == ""} {set test "$cmd should show completion"} - send "$cmd\t" - expect -ex "$cmd" - set trimmed false - if {$arg(ltrim-colon-completions)} { - # If partial contains colon (:), remove partial from begin of items - set trimmed [_ltrim_colon_completions $cmd expected cword] - } - if {! $trimmed} { - 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 $expected - if {[string first $cur $expected] == 0} { - set expected [list [string range $expected [string length $cur] end]] - } - } - - if {$arg(nospace)} {set endspace ""} else {set endspace "-end-space"} - if {[ - eval match_items \$expected -bash-sort -chunk-size \ - \$arg(chunk-size) $endspace -prompt \$prompt - ]} { - pass "$test" - } else { - fail "$test" - } -} - - -# @param string $cmd Command to remove current-word-to-complete from. -# @param string $dword (optional) Manually specify current-word-to-complete, -# i.e. word to remove from $cmd. If empty string (default), -# `_remove_cword_from_cmd' autodetects if the last argument is the -# current-word-to-complete by checking if $cmd doesn't end with whitespace. -# Specifying `dword' 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 string $common (optional) Common prefix of expected completions. -# @return string Command with current-word-to-complete removed -proc _remove_cword_from_cmd {cmd {dword ""} {common ""}} { - set cmd2 $cmd - # Is $dword specified? - if {[string length $dword] > 0} { - # Remove $dword from end of $cmd - if {[string last $dword $cmd] == [string length $cmd] - [string length $dword]} { - set cmd2 [string range $cmd 0 [expr [string last $dword $cmd] - 1]] - } - } else { - # No, $dword not specified; - # Check if last argument is really a word-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 - # $dword in those cases. - # Is last char whitespace? - if {! [string is space [string range $cmd end end]]} { - # No, last char isn't whitespace; - set cmds [split $cmd] - # Does word-to-complete start with $common? - if {[string first $common [lrange $cmds end end]] == 0} { - # Remove word-to-complete from end of $cmd - set cmd2 [lrange $cmds 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 "^\\S* $" { 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. Be prepared to filter out OLDPWD -# changes when calling assert_env_unmodified() after using this procedure. -# @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 Test title -# @param list $args See: assert_complete() -# @result boolean True if successful, False if not -proc assert_complete_dir {expected cmd dir {test ""} {args {}}} { - set prompt "/@" - assert_bash_exec "cd $dir" "" $prompt - eval assert_complete \$expected \$cmd \$test $args - sync_after_int $prompt - assert_bash_exec {cd "$TESTDIR"} -} - - - -# If cword contains colon (:), left-trim completions with cword -# @param string $cmd Command to complete -# @param list $items Reference to list of completions to trim -# @param string $dword Reference to variable to contain word to remove from -# expected cmd. -# See also: bash_completion._ltrim_colon_completions -proc _ltrim_colon_completions {cmd items dword} { - upvar 1 $items items_out - upvar 1 $dword dword_out - - 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 word-to-complete contains a colon, - # and COMP_WORDBREAKS contains a colon - if { - [string first : $cur] > -1 && [string first ":" $::COMP_WORDBREAKS] > -1 - } { - set dword_out $cur - for {set i 0} {$i < [llength $items_out]} {incr i} { - set item [lindex $items_out $i] - if {[string first $cur $item] == 0} { - # Strip colon-prefix - lset items_out $i [string range $item [string length $cur] end] - } - } - return true - } - return false -} - - -# 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; - } - } -} - - -# 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, and the command is available. -# @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 {[assert_bash_type $command] - && [assert_install_completion_for $command]} { - if {[string length $file] == 0} { - set file "$::srcdir/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 -# @param list $args Options: -# -unsorted Do not sort unique. Default is sort unique. -# @return list Hostnames -# @see get_known_hosts() -proc get_hosts {{args {}}} { - array set arg [::cmdline::getoptions args { - {unsorted "do not sort unique"} - }] - set sort "| sort -u" - if {$arg(unsorted)} {set sort ""} - set hosts [exec bash -c "compgen -A hostname $sort"] - # 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 -} - - -# 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 -} - - -# Try installing completion for the specified command. -# @param string $command Command to install completion for. -# @return boolean True (1) if completion is installed, False (0) if not. -proc assert_install_completion_for {command} { - set test "$command should have completion installed in bash" - set cmd "__load_completion $command ; 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, a limited number (20) at a time. -# Break items into chunks because `expect' seems to have a limited buffer size -# @param list $items Expected list items -# @param list $args Options: -# -bash-sort Compare list bash-sorted. Default is -# unsorted -# -prompt PROMPT Bash prompt. Default is `/@' -# -chunk-size CHUNK-SIZE Compare list CHUNK-SIZE items at -# a time. Default is 20. -# -end-newline Expect newline after last item. -# Default is not. -# -end-prompt Expect prompt after last item. -# Default is not. -# -end-space Expect single space after last item. -# Default is not. Valid only if -# `end-newline' not set. -# @result boolean True if successful, False if not -proc match_items {items {args {}}} { - array set arg [::cmdline::getoptions args { - {bash-sort "compare list sorted"} - {prompt.arg "/@" "bash prompt"} - {chunk-size.arg 20 "compare N list items at a time"} - {end-newline "expect newline after last item"} - {end-prompt "expect prompt after last item"} - {end-space "expect space ater last item"} - }] - set prompt $arg(prompt) - set size $arg(chunk-size) - if {$arg(bash-sort)} {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} { - if {$arg(end-prompt)} {set end $prompt} {set end ""} - # Both trailing space and newline are specified? - if {$arg(end-newline) && $arg(end-space)} { - # Indicate both trailing space or newline are ok - set expected2 "|^$expected $end$"; # Include space - append expected "\r\n$end"; # Include newline - } else { - if {$arg(end-newline)} {append expected "\r\n$end"} - if {$arg(end-space)} {append expected " $end"} - set expected2 "" - } - expect { - -re "^$expected$$expected2" { set result true } - -re "^$prompt$" {set result false; break } - default { set result false; break } - timeout { set result false; break } - } - } else { - set end "" - if {$arg(end-prompt) && $i + $j == [llength $items]} { - set end "$prompt" - _escape_regexp_chars end - # \$ matches real end of expect_out buffer - set end "$end\$" - } - expect { - -re "^$expected$end" { set result true } - default { set result false; break } - timeout { set result false; break } - } - } - } - 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 -o posix ; set); declare -F; shopt -p; set -o; } > \"$file\"" -} - - -# Source bash_completion package -proc source_bash_completion {} { - assert_bash_exec {source $(cd "$SRCDIR/.."; pwd)/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 - # Uniquify the list, that's what completion does too. - set list [lsort -unique $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 env srcdirabs - set TESTDIR [pwd] - set srcdirabs [file normalize $::srcdir]; # Absolute srcdir - # If `--tool_exec' option not specified, use "bash" - if {! [info exists TOOL_EXECUTABLE]} {set TOOL_EXECUTABLE bash} - set env(SRCDIR) $::srcdir - set env(SRCDIRABS) $::srcdirabs - - # PS1, INPUTRC, TERM and stty columns must be initialized - # *before* starting bash to take proper effect. - - # Set fixed prompt `/@' - set env(PS1) "/@" - # Configure readline - set env(INPUTRC) "$::srcdir/config/inputrc" - # Avoid escape junk at beginning of line from readline, - # see e.g. http://bugs.gentoo.org/246091 - set env(TERM) "dumb" - # Ensure enough columns so expect doesn't have to care about line breaks - set stty_init "columns 150" - - exp_spawn $TOOL_EXECUTABLE --norc - assert_bash_exec {} "$TOOL_EXECUTABLE --norc" - assert_bash_exec "source $::srcdir/config/bashrc" -} - - -# Redirect xtrace output to a file. -# -# 'set -x' can be very useful for debugging but by default it writes to -# stderr. -# -# 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}} { - 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_BUFFER_SIZE - if {![info exists OPT_BUFFER_SIZE]} { - set OPT_BUFFER_SIZE 20000 - } - verbose "Changing default expect match buffer size to $OPT_BUFFER_SIZE" - match_max $OPT_BUFFER_SIZE - 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]]/ -} |