Permalink
Browse files

test case: listenLoop calls all disconnect event functions on disconnect

  • Loading branch information...
1 parent 810cbc9 commit 1e6dae9e31ca60c2c158e41db0e3b54a74c13496 @mklinik mklinik committed Apr 21, 2012
Showing with 67 additions and 6 deletions.
  1. +1 −0 .ghci
  2. +5 −1 Network/SimpleIRC/Core.hs
  3. +5 −1 simpleirc.cabal
  4. +56 −4 tests/CoreSpec.hs
View
1 .ghci
@@ -0,0 +1 @@
+:set -itests -i. -DTEST
View
6 Network/SimpleIRC/Core.hs
@@ -8,7 +8,7 @@
-- Portability : portable
--
-- For information on how to use this library please take a look at the readme file on github, <http://github.com/dom96/SimpleIRC#readme>.
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, CPP #-}
module Network.SimpleIRC.Core
(
-- * Types
@@ -36,6 +36,10 @@ module Network.SimpleIRC.Core
, getPort
, getUsername
, getRealname
+#ifdef TEST
+ , IrcServer(..)
+ , listenLoop
+#endif
) where
import Network
View
6 simpleirc.cabal
@@ -42,7 +42,9 @@ test-suite spec
type:
exitcode-stdio-1.0
ghc-options:
- -Wall -Werror
+ -Wall
+ cpp-options:
+ -DTEST
hs-source-dirs:
., tests
main-is:
@@ -51,3 +53,5 @@ test-suite spec
base
, bytestring
, hspec
+ , HUnit
+ , knob
View
60 tests/CoreSpec.hs
@@ -1,9 +1,61 @@
-module CoreSpec (spec) where
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module CoreSpec (main, spec) where
+
+import Control.Concurrent
+import Test.HUnit
import Test.Hspec.Monadic
+import Test.Hspec.HUnit()
+import qualified Data.Knob as K
+import qualified Data.Map as Map
+import System.IO
+import qualified Data.ByteString.Char8 as B
+import Data.Unique
+
+import Network.SimpleIRC.Core
+
+appendMVar mList x = do
+ modifyMVar_ mList (\l -> return (x:l))
+
+mockMirc = do
+ k <- K.newKnob ""
+ h <- K.newFileHandle k "test connection" ReadWriteMode
+ u1 <- newUnique
+ u2 <- newUnique
+ u3 <- newUnique
+ resultList <- newMVar []
+ mIrc <- newMVar $ IrcServer
+ { sAddr = B.pack ""
+ , sPort = 0
+ , sNickname = B.pack ""
+ , sPassword = Nothing
+ , sUsername = B.pack ""
+ , sRealname = B.pack ""
+ , sChannels = []
+ , sEvents = Map.fromList [ (u1, Disconnect $ \_ -> appendMVar resultList True)
+ , (u2, Privmsg $ \_ _ -> appendMVar resultList False)
+ , (u3, Disconnect $ \_ -> appendMVar resultList True)
+ ]
+ , sSock = Just h
+ , sListenThread = Nothing
+ , sCmdThread = Nothing
+ , sCmdChan = undefined
+ , sDebug = False
+ -- Other info
+ , sCTCPVersion = ""
+ , sCTCPTime = return ""
+ , sPingTimeoutInterval = 10
+ }
+ return (resultList, mIrc)
+
+main = hspecX spec
spec :: Specs
spec = do
-describe "id" $ do
- it "returns the original argument" $
- id "foo" == "foo"
+ describe "listenLoop" $ do
+ it "calls the function of all disconnect events on disconnect" $ do
+ (mResultList, mIrc) <- mockMirc
+ listenLoop mIrc
+ resultList <- takeMVar mResultList
+ assertEqual "exactly both disconnect events have added their value to the result list" [True, True] resultList

0 comments on commit 1e6dae9

Please sign in to comment.