Posted to tcl by gay at Thu Mar 04 15:09:41 GMT 2021view pretty

source [file join \
        [file dirname [file dirname [file join [pwd] [info script]]]] \
        devtools testutilities.tcl]

testsNeedTcl     8.6
testsNeedTcltest 1.0

package require TclOO

support {
    useLocal ../virtchannel_core/events.tcl tcl::chan::events
    useLocal ../virtchannel_base/variable.tcl tcl::chan::variable
}

testing {
    useLocal picoirc.tcl picoirc
}

proc contextReset {data} {
    upvar #0 irc
    variable defaults
    array set irc $defaults
    set irc(callback) callback
    set irc(nick) anonymous
    set irc(data) "$data\n"
    set irc(socket) [tcl::chan::variable irc(data)]
    chan configure $irc(socket) -buffering line
    if {data != ""}
        ::picoirc::Read $irc(socket)
    }
    return
}

proc contextResult {} {
    upvar #0 irc
    close $irc(socket)
    return [lindex [split $irc(data) \n] 0]
}

proc callback {_ args} {
    upvar #0 data
    set data $args
    return
}

proc callbackResult {} {
    upvar #0 data
    vwait data
    return $data
}

test picoirc-1.0 {irc:// schema} -body {
    ::picoirc::splituri irc://chat.freenode.net
} -result [list chat.freenode.net 6667 {} 0]

test picoirc-1.1 {irc:// schema with port} -body {
    ::picoirc::splituri irc://irc.choopa.net:6654
} -result [list irc.choopa.net 6654 {} 0]

test picoirc-1.2 {irc:// schema with channel} -body {
    ::picoirc::splituri irc://chat.freenode.net/#tcl
} -result [list chat.freenode.net 6667 #tcl 0]

test picoirc-1.3 {irc:// schema with channel and port} -body {
    ::picoirc::splituri irc://chat.freenode.net:5347/#go-nuts
} -result [list chat.freenode.net 5347 #go-nuts 0]

test picoirc-1.4 {ircs:// schema} -body {
    ::picoirc::splituri ircs://185.98.4.3
} -result [list 185.98.4.3 6697 {} 1]

test picoirc-1.5 {ircs:// schema with port} -body {
    ::picoirc::splituri ircs://chat.freenode.net:69654
} -result [list chat.freenode.net 69654 {} 1]

test picoirc-1.6 {ircs:// schema with channel} -body {
    ::picoirc::splituri ircs://chat.freenode.net/#tcl
} -result [list chat.freenode.net 6697 #tcl 1]

test picoirc-1.7 {ircs:// schema with channel and port} -body {
    ::picoirc::splituri ircs://chat.freenode.net:76556/#go-nuts
} -result [list chat.freenode.net 76556 #go-nuts 1]

test picoirc-1.8 {address} -body {
    ::picoirc::splituri irc.freenode.net
} -result [list irc.freenode.net 6667 {} 0]

test picoirc-1.9 {address with port} -body {
    ::picoirc::splituri 243.75.9.4:8697
} -result [list 243.75.9.4 8697 {} 0]

test picoirc-1.10 {address with channel} -body {
    ::picoirc::splituri #tcl@chat.freenode.net
} -result [list chat.freenode.net 6667 #tcl 0]

test picoirc-1.11 {address with channel and port} -body {
    ::picoirc::splituri #go-nuts@chat.freenode.net:765
} -result [list chat.freenode.net 765 #go-nuts 0]

test picoirc-2.0 {channel message} -body {
    contextReset {:tcler!~anon@127.0.0.1 PRIVMSG #tcl :hello #tcl}
    callbackResult
} -result list [chat #tcl tcler {hello #tcl} {}]

test picoirc-2.1 {private message} -body {
    contextReset {:tcler!~anon@127.0.0.1 PRIVMSG anonymous :hey there}
    callbackResult
} -result list [chat tcler tcler {hey there} {}]