diff options
Diffstat (limited to 'test/lib/library.exp')
| -rw-r--r-- | test/lib/library.exp | 616 |
1 files changed, 388 insertions, 228 deletions
diff --git a/test/lib/library.exp b/test/lib/library.exp index c76d9854..61b3f409 100644 --- a/test/lib/library.exp +++ b/test/lib/library.exp @@ -1,7 +1,8 @@ - # Source `init.tcl' again to restore the `unknown' procedure - # NOTE: DejaGnu has an old `unknown' procedure which unfortunately disables - # tcl auto-loading. +# 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 @@ -22,7 +23,7 @@ proc assert_bash_exec {{aCmd ""} {title ""} {prompt /@} {out -1}} { 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 @@ -33,24 +34,16 @@ proc assert_bash_exec {{aCmd ""} {title ""} {prompt /@} {out -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 + fail "ERROR Unexpected output from bash command \"$title\"" + } 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() + $prompt {fail "ERROR executing bash command \"$title\""} + } +} # Test `type ...' in bash @@ -64,32 +57,45 @@ proc assert_bash_type {command} { 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}} { +# 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 {[match_items $expected $test $prompt $size]} { - expect { - -re $prompt { pass "$test" } - -re eof { unresolved "eof" } - } + 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" } @@ -97,130 +103,235 @@ proc assert_bash_list {expected cmd {test ""} {prompt /@} {size 20}} { } -proc assert_bash_list_dir {expected cmd dir {test ""} {prompt /@} {size 20}} { - set prompt "/$dir/@" +# 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 $prompt $size + assert_bash_list $expected $cmd $test $arg_sort \ + -chunk-size $arg(chunk-size) -prompt $prompt 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. +# 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 " +# +# If the entire $cmd is expected, specify `-expect-cmd-full'. +# # @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 ""}} { +# @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-full Expect the full $cmd to be echoed. Expected is: +# +# $cmd<TAB>\n +# $expected\n +# $prompt + $cmd + longest-common-prefix-of-$expected +# +# -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-full "Expect full cmd after prompt"} + {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 { - 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() + 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-full "Expect full cmd after prompt"} + {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] -# @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. + # 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-full "Expect full cmd after prompt"} + {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" + if {$arg(ltrim-colon-completions)} { + # If partial contains colon (:), remove partial from begin of items + _ltrim_colon_completions $cmd expected cword + } else { + 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 " -# @return string Command with cword removed -proc _remove_cword_from_cmd {cmd {cword ""}} { +# @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 $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 + # 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, $cword not specified; - # Check if last argument is really an-argument-to-complete, i.e. + # 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 - # $cword in those cases. + # $dword 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 + 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 -}; # _remove_cword_from_cmd() +} # Escape regexp special characters @@ -253,8 +364,8 @@ proc assert_complete_any {cmd {test ""} {prompt /@}} { } -re $prompt { unresolved "$test at prompt" } eof { unresolved "eof" } - }; # expect -}; # assert_complete_any() + } +} # Make sure the expected files are returned by TAB-completing the @@ -262,18 +373,16 @@ proc assert_complete_any {cmd {test ""} {prompt /@}} { # @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() +# @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 ""} {size 20} {cword ""}} { - set prompt "/$dir/@" +proc assert_complete_dir {expected cmd dir {test ""} {args {}}} { + set prompt "/@" assert_bash_exec "cd $dir" "" $prompt - assert_complete $expected $cmd $test $prompt $size $cword + assert_complete $expected $cmd $test $args sync_after_int $prompt assert_bash_exec {cd "$TESTDIR"} -}; # assert_complete_dir +} @@ -284,14 +393,9 @@ proc assert_complete_dir {expected cmd dir {test ""} {size 20} {cword ""}} { # @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 ""}} { +# @param string $test Test title +# @param list $args See: assert_complete() +proc assert_complete_partial {expected cmd {partial ""} {test ""} {args {}}} { if {$test == ""} {set test "$cmd should complete partial argument"} if {[llength $expected] == 0} { unresolved "$test" @@ -301,39 +405,54 @@ proc assert_complete_partial {expected cmd {partial ""} {test ""} {prompt /@} {s set expected [lsort -unique $expected] foreach item $expected { if {$partial == ""} {set partial [string range $item 0 0]} - # Only append item if starting with $partial + # 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() + } + } + # NOTE: The `eval' is necessary to flatten the $args list + # See also: http://wiki.tcl.tk/11787 - {expand} + eval assert_complete \$pick \"\$cmd \$partial\" \$test $args; #" + } +} +# 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 {cword items} { - upvar 1 $cword cword_out +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 bash-version < 4, # or bash-version >= 4 and COMP_WORDBREAKS contains a colon if { - [string first : $cword_out] > -1 && ( + [string first : $cur] > -1 && ( [lindex $::BASH_VERSINFO 0] < 4 || ([lindex $::BASH_VERSINFO 0] >= 4 && [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 $cword_out $item] == 0} { + if {[string first $cur $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() + lset items_out $i [string range $item [string length $cur] end] + } + } + } +} # Make sure the bash environment hasn't changed between now and the last call @@ -370,7 +489,7 @@ proc assert_env_unmodified {{sed ""} {file ""} {diff ""}} { append diff "\r\n" } else { set diff "" - }; # if + } # Execute diff @@ -392,11 +511,11 @@ proc assert_env_unmodified {{sed ""} {file ""} {diff ""}} { # 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. @@ -426,10 +545,10 @@ proc assert_exec {cmd {stdout ''} {test ''} {failcmd "unresolved"}} { unsupported "$test" } else { $failcmd "$test" - }; # if - }; # if + } + } return $result -}; # assert_exec() +} # Check that no completion is attempted on a certain command. @@ -439,7 +558,7 @@ proc assert_exec {cmd {stdout ''} {test ''} {failcmd "unresolved"}} { proc assert_no_complete {{cmd} {test ""}} { if {[string length $test] == 0} { set test "$cmd shouldn't complete" - }; # if + } send "$cmd\t" expect -ex "$cmd" @@ -451,8 +570,8 @@ proc assert_no_complete {{cmd} {test ""}} { -re "^$endguard$" { pass "$test" } default { fail "$test" } timeout { fail "$test" } - }; # expect -}; # assert_no_complete() + } +} # Check that no output is generated on a certain command. @@ -483,7 +602,7 @@ proc assert_no_output {{cmd} {test ""} {prompt /@}} { proc assert_source_completions {command {file ""}} { if {[is_bash_completion_installed_for $command]} { if {[string length $file] == 0} { - set file "lib/completions/$command.exp" + set file "$::srcdir/lib/completions/$command.exp" } source $file } else { @@ -510,7 +629,7 @@ proc get_known_hosts {{cword ''}} { assert_bash_exec "_known_hosts_real '$cword'; echo_array COMPREPLY" \ {} /@ result return $result -}; # get_known_hosts() +} # Get hostnames @@ -524,9 +643,9 @@ proc get_hosts {} { 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 @@ -540,9 +659,9 @@ proc get_hosts_avahi {} { # No, retrieving hosts yields error; # Reset hosts set hosts {} - }; # if + } return $hosts -}; # get_hosts_avahi() +} # Get signals @@ -558,21 +677,22 @@ proc get_signals {} { 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 + 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 -}; # init_tcl_bash_globals() + assert_bash_exec {eval $(locale); printf "%s" "$LC_CTYPE"} "" /@ LC_CTYPE +} # Check whether completion is installed for the specified command by executing @@ -590,22 +710,44 @@ proc is_bash_completion_installed_for {command} { } 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. +# 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 -# @param integer $size Chunk 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 test {prompt /@} {size 20}} { - set items [bash_sort $items] +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 @@ -614,28 +756,43 @@ proc match_items {items test {prompt /@} {size 20}} { 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} {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\r\n$" { set result true } - # NOTE: The optional space ( ?) depends on whether -o nospace is active - -re "^$expected ?$" { set result true } + -re "^$expected$$expected2" { 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 { + 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" { set result true } + -re "^$expected$end" { set result true } default { set result false; break } timeout { set result false; break } - }; # expect - }; # if - }; # for + } + } + } return $result -}; # match_items() +} @@ -651,10 +808,10 @@ proc realcommand {cmd} { set result [exec readlink -f $path] } else { set result $path - }; # if - }; # if + } + } return $result -}; # realcommand() +} # Generate filename to save environment to. @@ -674,10 +831,10 @@ proc gen_env_filename {{file ""} {seq 1}} { # 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 @@ -685,7 +842,7 @@ proc gen_env_filename {{file ""} {seq 1}} { # `gen_env_filename()'. proc save_env {{file ""}} { _save_env [gen_env_filename $file 1] -}; # save_env() +} # Save the environment for later comparison @@ -693,16 +850,16 @@ proc save_env {{file ""}} { # @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_DIR=$(cd "$SRCDIR/.."; 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 {BASH_COMPLETION=$(cd "$SRCDIR/.."; pwd)/bash_completion} assert_bash_exec {source "$BASH_COMPLETION"} -}; # source_bash_completion() +} # Split line into words, disregarding backslash escapes (e.g. \b (backspace), @@ -727,7 +884,7 @@ proc split_words_bash {line} { 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; @@ -738,11 +895,11 @@ proc split_words_bash {line} { # 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 @@ -814,19 +971,22 @@ proc find_unique_completion_pair {{list} {partName} {fullName}} { # Start bash running as test environment. proc start_bash {} { - global TESTDIR TOOL_EXECUTABLE spawn_id + 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} - exp_spawn $TOOL_EXECUTABLE --rcfile config/bashrc - assert_bash_exec {} "$TOOL_EXECUTABLE --rcfile config/bashrc" + set env(SRCDIR) $::srcdir + set env(SRCDIRABS) $::srcdirabs + exp_spawn $TOOL_EXECUTABLE --rcfile $::srcdir/config/bashrc + assert_bash_exec {} "$TOOL_EXECUTABLE --rcfile $::srcdir/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. @@ -896,7 +1056,7 @@ proc sync_after_tab {} { # 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 @@ -905,4 +1065,4 @@ proc wd {} { global TESTDIR # Remove `$TESTDIR' prefix from current working directory set wd [string replace [pwd] 0 [expr [string length $TESTDIR] - 1]]/ -}; # wd() +} |