tests: Add interactive mode tests

Using a custom "expect-like" module to allow testing Jim in interactive
mode. This also exercises the 'socket pty' support.

Signed-off-by: Steve Bennett <steveb@workware.net.au>

2 files changed, 368 insertions, 0 deletions

diff --git a/tests/expect.tcl b/tests/expect.tcl
new file mode 100644
index 0000000..e21efc0
--- /dev/null
+++ b/tests/expect.tcl
@@ -0,0 +1,231 @@
+# A simplified version of Tcl expect using a pseudo-tty pair
+# This could be turned into a standard module, but for now
+# it is just used in the test suite
+
+# Example usage:
+#
+# set p [expect::spawn {cmd pipeline}]
+#
+# $p timeout 5
+# $p send "a command\r"
+# $p expect {
+#	ab.*c {
+#		script
+#	}
+#	d[a-z] {
+#		script
+#	}
+#   EOF { ... }
+#   TIMEOUT { ... }
+# }
+#
+# [$p before] returns data before the match
+# [$p after] returns data that matches the pattern
+# [$p buf] returns any data after the match that has been read
+# $p close
+#
+# $p tty ?...?
+# $p kill ?SIGNAL?
+
+proc expect::spawn {cmd} {
+	lassign [socket pty] m s
+	# By default, turn off echo so that we can see just the output, not the input
+	$m tty echo 0
+	$m buffering none
+	try {
+		lappend cmd <@$s >@$s &
+		set pids [exec {*}$cmd]
+		$s close
+		# Create a unique global variable for vwait
+		set donevar ::[ref "" expect]
+		set $donevar 0
+		set matchinfo {
+			buf {}
+		}
+
+		return [namespace current]::[lambda {cmd args} {m pids {timeout 30} donevar matchinfo {debug 0}} {
+			#puts "expect::spawn cmd=$cmd, matchinfo=$matchinfo"
+			# Find our own name
+			set self [lindex [info level 0] 0]
+
+			switch -exact -- $cmd {
+				dputs {
+					if {$debug} {
+						set escapes {13 \\r 10 \\n 9 \\t 92 \\\\}
+						lassign $args str
+						# convert non-printable chars to printable
+						set formatted {}
+						binary scan $str cu* chars
+						foreach c $chars {
+							if {[exists escapes($c)]} {
+								append formatted $escapes($c)
+							} elseif {$c < 32} {
+								append formatted [format \\x%02x $c]
+							} elseif {$c > 127} {
+								append formatted [format \\u%04x $c]
+							} else {
+								append formatted [format %c $c]
+							}
+						}
+						puts $formatted
+					}
+				}
+				kill {
+					# kill the process with the given signal
+					foreach i $pids {
+						kill {*}$args $i
+					}
+				}
+				pid {
+					# return the process pids
+					return $pids
+				}
+				getfd - tty {
+					# pass through to the pty file descriptor
+					tailcall $m $cmd {*}$args
+				}
+				close {
+					# close the file descriptor, wait for the child process to complete
+					# and return the result
+					$m close
+					set retopts {}
+					foreach p $pids {
+						lassign [wait $p] status - rc
+						if {$status eq "CHILDSTATUS"} {
+							# Don't treat a non-zero return code as fatal here
+							if {[llength $retopts] <= 1} {
+								set retopts $rc
+							}
+							continue
+						} else {
+							set msg "child killed: received signal"
+						}
+						set retopts [list -code error -errorcode [list $status $p $rc] $msg]
+					}
+					rename $self ""
+
+					return {*}$retopts
+				}
+				timeout - debug {
+					# set or return the variable
+					if {[llength $args]} {
+						set $cmd [lindex $args 0]
+					} else {
+						return [set $cmd]
+					}
+				}
+				send {
+					$self dputs ">>> [lindex $args 0]"
+					# send to the process
+					$m puts -nonewline [lindex $args 0]
+					$m flush
+				}
+				before - after - buf {
+					# return the before, after and remaining data
+					return $matchinfo($cmd)
+				}
+				handle {
+					# Internal use only
+					set args [lassign $args type]
+					switch -- $type {
+						timeout {
+							$self dputs "\[TIMEOUT patterns=$matchinfo(patterns) buf=$matchinfo(buf)\]"
+							# a timeout occurred
+							set matchinfo(before) $matchinfo(buf)
+							set matchinfo(buf) {}
+							set matchinfo(matched_pattern) TIMEOUT
+							incr $donevar
+							return 1
+						}
+						eof {
+							$self dputs "\[EOF\]"
+							# EOF was reached
+							set matchinfo(before) $matchinfo(buf)
+							set matchinfo(buf) {}
+							set matchinfo(matched_pattern) EOF
+							incr $donevar
+							return 1
+						}
+						data {
+							# data was received
+							lassign $args data
+							$self dputs "<<< $data"
+							append matchinfo(buf) $data
+							foreach pattern $matchinfo(patterns) {
+								set result [regexp -inline -indices $pattern $matchinfo(buf)]
+								if {[llength $result]} {
+									$self dputs "MATCH=\[$pattern\]"
+									lassign [lindex $result 0] start end
+									set matchinfo(before) [string range $matchinfo(buf) 0 $start-1]
+									set matchinfo(after) [string range $matchinfo(buf) $start $end]
+									set matchinfo(buf) [string range $matchinfo(buf) $end+1 end]
+
+									# Got a match, stop
+									set matchinfo(matched_pattern) $pattern
+									incr $donevar
+									return 1
+								}
+							}
+						}
+					}
+					return 0
+				}
+				expect {
+					# Takes a list of regex-pattern, script, ... where the last script can be missing
+					if {[llength $args] % 2 == 1} {
+						lappend args {}
+					}
+
+					# Stash all the state in the matchinfo dict
+					# Keep matchinfo(buf)
+					array set matchinfo {
+						before {}
+						after {}
+						patterns {}
+						matched_pattern {}
+					}
+
+					foreach {pattern script} $args {
+						lappend matchinfo(patterns) $pattern
+					}
+
+					# Handle the case where there is buffered data
+					# that matches the pattern
+					if {[$self handle data {}] == 0} {
+						$m readable [namespace current]::[lambda {} {m self} {
+							$m ndelay 1
+							try {
+								set buf [$m read]
+								if {$buf eq ""} {
+									$self handle eof "EOF"
+								} else {
+									$self handle data $buf
+								}
+							} on error msg {
+								$self handle eof $msg
+							}
+							$m ndelay 0
+						}]
+						set matchinfo(afterid) [after $($timeout * 1e3) [list $self handle timeout]]
+
+						vwait $donevar
+
+						after cancel $matchinfo(afterid)
+					}
+
+					# Now invoke the matching script
+					if {[dict exists $args $matchinfo(matched_pattern)]} {
+						uplevel 1 [dict get $args $matchinfo(matched_pattern)]
+					}
+					# And return the data that matched the pattern
+					# (is $matchinfo(before) more generally useful?)
+					return $matchinfo(after)
+				}
+			}
+		}]
+	} on error {error opts} {
+		catch {$m close}
+		catch {$s close}
+		return -code error $error
+	}
+}
diff --git a/tests/interactive.test b/tests/interactive.test
new file mode 100644
index 0000000..d403775
--- /dev/null
+++ b/tests/interactive.test
@@ -0,0 +1,137 @@
+source [file dirname [info script]]/testing.tcl
+
+needs constraint jim
+
+package require expect
+
+set saveenv $env
+
+# Make sure we start with an empty history
+set env(HOME) [pwd]
+file delete .jim_history
+
+# spawn the process to be used for testing
+set p [expect::spawn [info nameofexecutable]]
+
+set env $saveenv
+
+$p timeout 1
+# Turn on echo since we get echo with linenoise anyway
+$p tty echo 1
+
+proc wait-for-prompt {p} {
+	$p expect {\. }
+}
+
+# Start with an empty history
+file delete test_history
+wait-for-prompt $p
+$p send "history load test_history\r"
+# skip echoed output
+$p expect {\r\n}
+wait-for-prompt $p
+
+test interactive-1.1 {basic command} -body {
+	$p send "lsort \[info commands li*\]\r"
+	# skip echoed output
+	$p expect {\r\n}
+	# get command result
+	$p expect {\r\n}
+	$p before
+} -result {lindex linsert list} -cleanup {
+	wait-for-prompt $p
+}
+
+test interactive-1.2 {command line completion} {
+	set check 0
+	set failed 0
+	$p send "li\t"
+	$p expect {lindex} { incr check } TIMEOUT { incr failed }
+	if {!$failed} {
+		$p send "\t"
+		$p expect {linsert} { incr check }
+		$p send "\t"
+		$p expect {list} { incr check }
+		$p send \r
+	}
+	$p expect {\r\n}
+	wait-for-prompt $p
+
+	list $check $failed
+} {3 0}
+
+test interactive-1.3 {history show} -body {
+	$p send "history show\r"
+	$p expect {\r\n}
+	$p expect {history show\r\n}
+	string cat [$p before] [$p after]
+} -result "   1 history load test_history\r\n   2 lsort \[info commands li*\]\r\n   3 list\r\n   4 history show\r\n" -cleanup {
+	wait-for-prompt $p
+}
+
+test interactive-1.4 {history getline} -body {
+	$p send "history getline {PROMPT> }\r"
+	$p expect {\r\n}
+	sleep 0.25
+	$p send "abc\bd\x01e\r"
+	$p expect {\r\n}
+	$p expect {\r\n}
+	$p before
+} -result {eabd} -cleanup {
+	wait-for-prompt $p
+}
+
+test interactive-1.4 {history getline} -body {
+	$p send "set len \[history getline {PROMPT> } buf\]\r"
+	$p expect {\r\n}
+	sleep 0.25
+	$p send "abcde\r"
+	$p expect {\r\n}
+	$p expect {\r\n}
+	sleep 0.25
+	$p wait-for-prompt
+	$p send "list \$len \$buf\r"
+	$p expect {\r\n}
+	$p expect {\r\n}
+	$p before
+} -result {5 abcde} -cleanup {
+	wait-for-prompt $p
+}
+
+test interactive-1.5 {insert wide character} -constraints utf8 -body {
+	$p send "set x a\u1100b"
+	# now arrow left twice over the wide char and insert another char
+	$p send \x1bOD
+	$p send \x1bOD
+	$p send y
+	$p send \r
+	$p expect {\r\n}
+	sleep 0.25
+	$p expect {\r\n}
+	$p before
+} -result ay\u1100b -cleanup {
+	wait-for-prompt $p
+}
+
+test interactive-1.6 {insert utf-8 combining character} -constraints utf8 -body {
+	$p send "set x x\u0300"
+	# now arrow left twice over the combining char and "x" and insert another char
+	$p send \x1bOD
+	$p send \x1bOD
+	$p send y
+	$p send \r
+	$p expect {\r\n}
+	sleep 0.25
+	$p expect {\r\n}
+	$p before
+} -result yx\u0300 -cleanup {
+	wait-for-prompt $p
+}
+
+# send ^D to cause the interpeter to exit
+$p send \x04
+sleep 0.25
+$p expect EOF
+$p close
+
+testreport