# vim: set filetype=expect sw=4 ts=4 et:
#
# This file is meant to be sourced by the `expect` command before running the actual test script.

log_user 0
log_file -noappend interactive.tmp.log

set ksh $env(SHELL)
set timeout 2
set send_human {.05 .1 5 .02 .2}

proc abort {{msg "aborting"}} {
    error $msg
    exit 1
}

# Debug logging

set loglevel debug ; # none, info, debug

proc log_info string {
    global loglevel
    switch $loglevel {
        info -
        debug {
            send_log "<I> $string\n"
        }
    }
}

proc log_debug string {
    global loglevel
    switch $loglevel {
        debug {
            send_log "<D> $string\n"
        }
    }
}

# Utilities

set prompt_counter 1
# expect_prompt takes an argument list like `expect` does.
# It supports a special pattern "unmatched" that is run if no
# other provided patterns match, and a special flag "-nounmatched"
# that marks the following pattern as not being tracked for
# "unmatched" handling.
# If multiple patterns are provided, they may all match. Each pattern
# is matched at most once. The matching only ends once the prompt is
# found.
#
# The weird `|\\^C|\\^D\\x08\\x08` component in prompt_pat is to deal with unit tests which send a
# [ctrl-C] to terminate a process or [ctrl-D] to terminate the input to a program. There is at least
# one unit test that causes that sequence to appear just before the next prompt. Solaris (and
# probably other SVR4 based systems) behaves weird in this regard (at least when compared to Linux
# and BSD).
#
proc expect_prompt {args} {
    global prompt_counter
    upvar expect_out expect_out
    set prompt_pat [list -re "(?:^|\\r\\n?)(?:\\\[.\\\] |\\^C|\\^D\\x08\\x08)?KSH PROMPT:$prompt_counter: "]
    if {[llength $args] == 1 && [string match "\n*" $args]} {
        set args [join $args]
    }
    set prompt_action ""
    set expargs {}
    set debugpats {}
    set nounmatched no
    set matchidx 0
    set matched(any) no
    set state "firstarg"
    foreach arg $args {
        switch $state {
            "pat" {
                lappend expargs $arg
                set state "action"
            }
            "action" {
                lappend debugpats [lindex $expargs end]
                lappend expargs [subst -nocommands {
                    log_debug "matched extra pattern to expect_prompt: [quote \$expect_out(0,string)]"
                    if {!\$matched($matchidx)} {
                        set matched($matchidx) yes
                        if {!$nounmatched} { set matched(any) yes }
                        uplevel 1 {$arg}
                    }
                    exp_continue
                }]
                set matched($matchidx) no
                incr matchidx
                set state "firstarg"
                set nounmatched no
            }
            "firstarg" -
            "arg" {
                if {$arg eq "unmatched" && $state eq "firstarg"} {
                    set state "unmatched"
                    continue
                }
                set keep yes
                switch -glob -- $arg {
                    -gl -
                    -re -
                    -ex {
                        lappend debugpats $arg
                        set state "pat"
                    }
                    -i -
                    -timeout {
                        set state "flagarg"
                    }
                    -nounmatched {
                        set keep no
                        set nounmatched yes
                        set state "arg"
                    }
                    -* {
                        error "BUG: unknown expect flag in expect_prompt"
                    }
                    default {
                        set state "action"
                    }
                }
                if {$keep} {
                    lappend expargs $arg
                }
            }
            "flagarg" {
                lappend expargs $arg
                set state "arg"
            }
            "unmatched" {
                set state "firstarg"
                if {$prompt_action ne ""} continue
                set prompt_action [subst -nocommands {
                    if {!\$matched(any)} {
                        log_debug "triggered unmatched action in expect_prompt"
                        log_debug "expect buffer: [quote \$expect_out(buffer)]"
                        uplevel 1 {$arg}
                    }
                }]
            }
            default {
                error "BUG: non-exhaustive switch in expect_prompt"
            }
        }
    }
    if {[llength $debugpats] > 0} {
        log_info "expecting prompt $prompt_counter + \[$debugpats]"
    } else {
        log_info "expecting prompt $prompt_counter"
    }
    set expargs [concat $expargs $prompt_pat [list $prompt_action]]
    expect {*}$expargs
    incr prompt_counter
}

trace add execution expect {enter leave} trace_expect
proc trace_expect {cmd args} {
    if {[lindex $cmd 1] eq "*" && [llength $cmd] == 3} {
        # it's an `expect "*" {..}` command, don't log it
        return
    }
    switch [lindex $args end] {
        enter {
            log_debug "entering expect"
            uplevel {set expect_out(buffer) {}}
        }
        leave {
            set code [lindex $args 0]
            if {$code == 0} {
                log_debug "expect finished: [quote [uplevel set expect_out(buffer)]]"
            } else {
                log_debug "expect returned code $code"
            }
        }
    }
}

trace add execution exp_continue enter trace_exp_continue
proc trace_exp_continue {cmd op} {
    log_debug "exp_continue after consuming: [quote [uplevel set expect_out(buffer)]]"
}


trace add execution send enter trace_send
proc trace_send {cmd op} {
    log_info "[quote $cmd]"
}

trace add execution spawn {enter leave} trace_spawn
proc trace_spawn {cmd args} {
    switch [lindex $args end] {
        enter {
            log_info "[quote $cmd]"
        }
        leave {
            log_debug "[quote $cmd]: code [lindex $args 0], result [lindex $args 1]"
            expect_after {
                timeout {
                    expect "*" {
                        log_debug "timeout; buffer=[quote $expect_out(buffer)]"
                    }
                    abort "timeout"
                }
                eof {
                    log_debug "eof; buffer=[quote $expect_out(buffer)]"
                    # even though we're about to abort, we want to wait so we can get the status
                    # note: it's possible that fish could have closed its end and then hung, and
                    # expect doesn't provide any way to set a timeout for wait. But I think that's
                    # an acceptable risk.
                    puts stderr "eof; waiting on child process to exit"
                    set status [wait]
                    if {[lindex $status 2] == -1} {
                        # operating system error
                        puts stderr "error: OS error code [lindex $status 3]"
                    } else {
                        set msg "process [lindex $status 0] exited with status [lindex $status 3]"
                        if {[llength $status] > 4} {
                            append msg " ([lrange $status 4 end])"
                        }
                        puts stderr $msg
                    }
                    abort "eof"
                }
            }
        }
    }
}

proc quote string {
    set map {
        \\      \\\\
        \r      \\r
        \n      \\n
        \t      \\t
        \a      \\a
        \v      \\v
        \x1b    \\e
        \x7f    \\x7f
    }
    for {set x 0} {$x<32} {incr x} {
        lappend map [format %c $x] [format \\x%02x $x]
    }
    string map $map $string
}

proc lineno args {
    return [dict get [info frame 1]  line]
}

proc log_test_entry args {
    log_info "========== STARTING TEST AT LINE [lineno] =========="
    if {[llength $args] > 0} {
        puts "========== STARTING TEST $args"
    }
}

proc send_line args {
    if {[llength $args] > 0} {
        lset args end [lindex $args end]\r
    }
    send {*}$args
}

proc rand_int {low hi} {
    expr {entier(rand() * ($hi-$low))+$low}
}

# prints the output of `_echo_var $name` (defined in interactive.config)
proc print_var_contents name {
    # generate a random "guard" so we know where to stop matching
    # the randomness is to defend against the variable value containing the guard
    set guard [rand_int 1000000000 9999999999]

    # print the variable
    log_info "get_var_contents: $$name"
    send_line "_echo_var $name $guard"

    # match on the results
    set pat {\r\n@GUARD:$guard@\r\n(.*)\r\n@/GUARD:$guard@\r\n}
    expect_prompt -re [subst -nocommands -nobackslashes $pat] {
        log_info "get_var_contents: result: [quote $expect_out(1,string)]"
        puts $expect_out(1,string)
        exp_continue
    } unmatched {
        log_debug "unmatched: [quote $expect_out(buffer)]"
        abort "Didn't match output for variable $$name"
    }
}

# Convert an ASCII character to its control char equivalent.
#
# This must be called with a single ASCII char.
#
# Returns the control-char version of the char.
proc ctrl char {
    if {$char == "esc"} {
        return \x1b
    }
    if {$char == "del"} {
        return \x7f
    }
    if {$char == "?"} {
        return \x7f
    }
    return [format %c [expr ([scan $char %c] & 0x1F)]]
}

# Send a [ctrl-L] to force the shell to redraw the prompt and command line. Doing so makes it easier
# to verify the command line contains the expected text.
proc redraw_prompt args {
    send [ctrl L]
}
