Posted to tcl by gay at Thu Mar 04 15:39:18 GMT 2021view pretty
source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.6 testsNeedTcltest 2.0 package require TclOO support { use virtchannel_core/events.tcl tcl::chan::events use 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 } puts PING test picoirc-1.0 {irc:// schema} -body { ::picoirc::splituri irc://chat.freenode.net } -result [list chat.freenode.net 6667 {} 0] puts PONG 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} {}] testsuiteCleanup