u6a/tests/init.exp

##
 # init.exp - u6a test init script
 # 
 # Copyright (C) 2020  CismonX <admin@cismon.net>
 #
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation, either version 3 of the License, or
 # (at your option) any later version.
 #
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
 #

proc u6a_dump_mnemonics { src_code } {
    global U6AC_BIN
    if { [ catch { exec $U6AC_BIN -S - << $src_code } result ] == 0 } {
        return $result
    } else {
        fail "failed to dump mnemonics of program"
    }
}

proc u6a_run { src_code u6ac_opts u6a_opts has_input } {
    global U6A_BIN U6AC_BIN U6A_RUN B64_ENCODE B64_DECODE
    set u6ac "$U6AC_BIN $u6ac_opts"
    set u6a "$U6A_BIN $u6a_opts"
    set run_cmd [ list $U6A_RUN $u6ac $u6a $B64_ENCODE $B64_DECODE $src_code ]
    if $has_input {
        lappend run_cmd -
        set stty_init -echo
    } else {
        set stty_init { raw -echo }
    }
    global spawn_id
    spawn {*}$run_cmd
}

proc u6a_stop { send_eof } {
    global spawn_id
    if $send_eof {
        send \x04
        expect eof
    }
    catch wait result
    if [ set exit_code [ lindex $result 3 ] ] {
        fail "program exited with code $exit_code"
    }
}