Posted to tcl by gay at Thu Mar 04 15:55:36 GMT 2021view raw

  1. source [file join \
  2. [file dirname [file dirname [file join [pwd] [info script]]]] \
  3. devtools testutilities.tcl]
  4.  
  5. testsNeedTcl 8.6
  6. testsNeedTcltest 2.0
  7.  
  8. package require TclOO
  9.  
  10. support {
  11. use virtchannel_core/events.tcl tcl::chan::events
  12. use virtchannel_base/variable.tcl tcl::chan::variable
  13. }
  14.  
  15. testing {
  16. useLocal picoirc.tcl picoirc
  17. }
  18. puts "Error's here!"
  19. proc contextReset {data} {
  20. variable ::picoirc::irc
  21. variable ::picoirc::defaults
  22. array set irc $defaults
  23. set irc(callback) callback
  24. set irc(nick) anonymous
  25. set irc(data) "$data\n"
  26. set irc(socket) [tcl::chan::variable irc(data)]
  27. chan configure $irc(socket) -buffering line
  28. if {$data != ""}
  29. ::picoirc::Read $irc(socket)
  30. }
  31. return
  32. }
  33. error DING
  34. proc contextResult {} {
  35. variable ::picoirc::irc
  36. close $irc(socket)
  37. return [lindex [split $irc(data) \n] 0]
  38. }
  39. error DONG
  40. proc callback {_ args} {
  41. upvar #0 data
  42. set data $args
  43. return
  44. }
  45.  
  46. proc callbackResult {} {
  47. upvar #0 data
  48. vwait data
  49. return $data
  50. }
  51. error PING
  52. test picoirc-1.0 {irc:// schema} -body {
  53. ::picoirc::splituri irc://chat.freenode.net
  54. } -result [list chat.freenode.net 6667 {} 0]
  55. error PONG
  56. test picoirc-1.1 {irc:// schema with port} -body {
  57. ::picoirc::splituri irc://irc.choopa.net:6654
  58. } -result [list irc.choopa.net 6654 {} 0]
  59.  
  60. test picoirc-1.2 {irc:// schema with channel} -body {
  61. ::picoirc::splituri irc://chat.freenode.net/#tcl
  62. } -result [list chat.freenode.net 6667 #tcl 0]
  63.  
  64. test picoirc-1.3 {irc:// schema with channel and port} -body {
  65. ::picoirc::splituri irc://chat.freenode.net:5347/#go-nuts
  66. } -result [list chat.freenode.net 5347 #go-nuts 0]
  67.  
  68. test picoirc-1.4 {ircs:// schema} -body {
  69. ::picoirc::splituri ircs://185.98.4.3
  70. } -result [list 185.98.4.3 6697 {} 1]
  71.  
  72. test picoirc-1.5 {ircs:// schema with port} -body {
  73. ::picoirc::splituri ircs://chat.freenode.net:69654
  74. } -result [list chat.freenode.net 69654 {} 1]
  75.  
  76. test picoirc-1.6 {ircs:// schema with channel} -body {
  77. ::picoirc::splituri ircs://chat.freenode.net/#tcl
  78. } -result [list chat.freenode.net 6697 #tcl 1]
  79.  
  80. test picoirc-1.7 {ircs:// schema with channel and port} -body {
  81. ::picoirc::splituri ircs://chat.freenode.net:76556/#go-nuts
  82. } -result [list chat.freenode.net 76556 #go-nuts 1]
  83.  
  84. test picoirc-1.8 {address} -body {
  85. ::picoirc::splituri irc.freenode.net
  86. } -result [list irc.freenode.net 6667 {} 0]
  87.  
  88. test picoirc-1.9 {address with port} -body {
  89. ::picoirc::splituri 243.75.9.4:8697
  90. } -result [list 243.75.9.4 8697 {} 0]
  91.  
  92. test picoirc-1.10 {address with channel} -body {
  93. ::picoirc::splituri #tcl@chat.freenode.net
  94. } -result [list chat.freenode.net 6667 #tcl 0]
  95.  
  96. test picoirc-1.11 {address with channel and port} -body {
  97. ::picoirc::splituri #go-nuts@chat.freenode.net:765
  98. } -result [list chat.freenode.net 765 #go-nuts 0]
  99.  
  100. test picoirc-2.0 {channel message} -body {
  101. contextReset {:tcler!~anon@127.0.0.1 PRIVMSG #tcl :hello #tcl}
  102. callbackResult
  103. } -result [list chat #tcl tcler {hello #tcl} {}]
  104.  
  105. test picoirc-2.1 {private message} -body {
  106. contextReset {:tcler!~anon@127.0.0.1 PRIVMSG anonymous :hey there}
  107. callbackResult
  108. } -result [list chat tcler tcler {hey there} {}]
  109.  
  110. testsuiteCleanup
  111.