# test_simple.exp
#
# Simple commands for running user shell commands and checking their outputs.
# Also provided commands for generic string value and boolean value checks.

# run_cmd_2way CMD STDOUT_VAR STDERR_VAR
# * CMD is a string value for the user shell command to run.
# * STDOUT_VAR is the (output) variable name (without the `$` prefix!) to hold
#   the stdout output.
# * STDERR_VAR is the (output) variable name (without the `$` prefix!) to hold
#   the stderr output.
# Returns the exit code number
# TODO add timeout protection

proc run_cmd_2way { cmd stdout_var stderr_var } {
    upvar 1 $stdout_var stdout
    upvar 1 $stderr_var stderr

    send_log "executing: $cmd\n"

    set pipe [open "| sh -c {$cmd}" r]
    set stdout [read $pipe]
    set exit_code 0
    if {[catch {close $pipe} stderr] != 0} {
        if {$stderr ne "" && [string index $stderr end] ne "\n"} {
            # Alas. close() automatically remove the trailing newline, so we
            # have to add it back here...
            append stderr "\n"
        }
        global errorCode
        if {[lindex $errorCode 0] eq "CHILDSTATUS"} {
            set exit_code [lindex $errorCode 2]
        }
    }

    return $exit_code
}

# like TEST_NAME GOT REGEX_PATTERN REGEX_OPTS
# The test passes when the TARGET_STR string matches the regex in REGEX_PATTERN.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * REGEX_PATTERN is a tcl regular expression string to be matched against.
# * REGEX_OPTS is optional regex options like -expanded and -nocase.
# Returns 1 when the check passes, 0 otherwise.

proc like { test_name target regex regex_opts } {
    regsub -all -- {\n} $regex {\n} escaped_regex
    if {[regexp {*}$regex_opts -- $regex $target]} {
        pass "${test_name}: matches regex \"$escaped_regex\""
        return 1
    }
    fail "${test_name}: fails to match regex \"$escaped_regex\": got \"$target\""
    return 0
}

# unlike TEST_NAME GOT REGEX_PATTERN REGEX_OPTS
# The test passes when the GOT string does NOT match the regex in
# REGEX_PATTERN.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * REGEX_PATTERN is a tcl regular expression string to be matched against.
# * REGEX_OPTS is optional regex options like -expanded and -nocase.
# Returns 1 when the check passes, 0 otherwise.

proc unlike { test_name got regex regex_opts } {
    regsub -all -- {\n} $regex {\n} escaped_regex
    if {[regexp {*}$regex_opts -- $regex $got]} {
        fail "${test_name}: should NOT match regex \"$escaped_regex\" but matches: got \"$got\""
        return 0
    }
    pass "${test_name}: matches regex \"$escaped_regex\""
    return 1
}

# is TEST_NAME GOT EXPECTED
# The test passes when the GOT string is (exactly) equal to the string EXPECTED.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * EXPECTED is the expected string to be matched.
# Returns 1 when the check passes, 0 otherwise.

proc is { test_name got expected } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {$got eq $expected} {
        pass "${test_name}: string is \"$escaped_exp\""
        return 1
    }
    fail "${test_name}: string should be \"$escaped_exp\", but got \"$got\""
    return 0
}

# isnt TEST_NAME GOT EXPECTED
# The test passes when the GOT string is NOT equal to the string EXPECTED.
# * TEST_NAME is a string describing the current check.
# * GOT is the target string to be checked.
# * EXPECTED is the expected string to be matched.
# Returns 1 when the check passes, 0 otherwise.

proc isnt { test_name got expected } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {$got eq $expected} {
        fail "${test_name}: string should NOT be \"$escaped_exp\", but got \"$got\""
        return 0
    }
    pass "${test_name}: string should NOT be \"$escaped_exp\""
    return 1
}

# ok TEST_NAME RESULT
# The test passes when RESULT is a true value in Tcl.
# * TEST_NAME is a string describing the current check.
# * RESULT is the boolean value to be checked
# Returns 1 when the check passes, 0 otherwise.

proc ok { test_name result } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {! $result} {
        fail "${test_name}: not ok: $result"
        return 0
    }
    pass "${test_name}: ok: $result"
    return 1
}

# nok TEST_NAME RESULT
# The test passes when RESULT is a *false* value in Tcl.
# * TEST_NAME is a string describing the current check.
# * RESULT is the boolean value to be checked
# Returns 1 when the check passes, 0 otherwise.

proc nok { test_name result } {
    regsub -all -- {\n} $expected {\n} escaped_exp
    if {$result} {
        fail "${test_name}: should NOT be ok but is ok: $result"
        return 0
    }
    pass "${test_name}: sould NOT be ok: $result"
    return 1
}

# process_template_file TEMPLATE_FILE OUT_FILE BIN_FILE ERR_VAR
# Processes the template file specified by the TEMPLATE_FILE argument,
# expands special macro variables in the template file, and genetates the final
# .stp file specified by the OUT_FILE argument.
# The following macro variables are supported:
# * $^PWD for the current working directory
# * $^ADDR_NAME for the hex address (without the 0x prefix) for the symbol
#   named NAME by inspecting the binary target program file BIN_FILE via the
#   nm utility.
# Returns 1 when all macro variables are expanded successfully; 0 otherwise.
# In case of error, the error message will be returned in the variable with
# the name specified by the 4th argument.

proc process_template_file { template_file out_file bin_file err_var } {
    upvar 1 $err_var err

    set in [open $template_file r]
    set src [read $in]
    close $in

    set cwd [pwd]
    regsub -all -- {\$\^PWD\y} $src $cwd src

    set matches [regexp -all -inline -- {\$\^ADDR_([_a-zA-Z]\w*)} $src]

    set nsyms 0
    if {[llength $matches] > 0} {
        array set names {}
        foreach {match, name} $matches {
            if {! [info exists names($name)]} {
                incr nsyms
                set names($name) 1
            }
        }

        set nm_fh [open "| nm --defined-only ./a.out" r]
        set hits 0
        while {[gets $nm_fh line] >= 0} {
            if {[regexp -- {^\s*([0-9a-f]+)\s+[DT]\s+([_a-zA-Z]\w*)\s*$} $line \
                    match addr name]} {
                if {! [info exists names($name)]} {
                    continue
                }
                unset names($name)
                send_log "found symbol '$name' at addr $addr in the nm output\n"
                regsub -all -- "\\$\\^ADDR_$name\\y" $src $addr src
                if {[incr hits] == $nsyms} {
                    break
                }
            }
        }

        if {[catch {close $nm_fh} nm_err] != 0} {
            global errorCode
            if {[lindex $errorCode 0] eq "CHILDSTATUS"} {
                if {[lindex $errorCode 2] != 0} {
                    set err "failed to run nm: $nm_err"
                    return 0
                }
            }
        }

        if {$hits < $nsyms} {
            set unmatched_names [array names names]
            if {[llength $unmatched_names] == 1} {
                set sym [lindex $unmatched_names 0]
                set err "symbol '$sym' not found in binary file $bin_file"
                return 0
            }

            set sym_list [join [lmap e [array names names] { expr {"'$e'"} }] ", "]
            set err "symbols $sym_list not found in binary file $bin_file"
            return 0
        }
    }

    set out [open $out_file w+]
    puts -nonewline $out $src
    close $out

    return 1
}
