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