Anonymous avatar Anonymous committed e96d949

Convert tests to HUnit with HPC

Comments (0)

Files changed (6)

+import Distribution.Simple
+main = defaultMain
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings   #-}
+
+module Main where
+
+import Prelude hiding (lookup)
+
+import           Control.Concurrent
+import           Control.Exception
+import           Control.Monad
+import           Data.Configurator
+import           Data.Configurator.Types
+import           Data.Functor
+import           Data.Maybe
+import           Data.Text ()
+import qualified Data.ByteString.Lazy.Char8 as L
+import           System.Directory
+import           System.IO
+import           Test.HUnit
+
+main :: IO ()
+main = runTestTT tests >> return ()
+
+tests :: Test
+tests = TestList [
+    "load" ~: loadTest,
+    "reload" ~: reloadTest
+    ]
+
+withLoad :: [Worth FilePath] -> (Config -> IO ()) -> IO ()
+withLoad files t = do
+    mb <- try $ load files
+    case mb of
+        Left (err :: SomeException) -> assertFailure (show err)
+        Right cfg -> t cfg
+
+withReload :: [Worth FilePath] -> ([Maybe FilePath] -> Config -> IO ()) -> IO ()
+withReload files t = do
+    tmp   <- getTemporaryDirectory
+    temps <- forM files $ \f -> do
+        exists <- doesFileExist (worth f)
+        if exists
+            then do
+                (p,h) <- openBinaryTempFile tmp "test.cfg"
+                L.hPut h =<< L.readFile (worth f)
+                hClose h
+                return (p <$ f, Just p)
+            else do
+                return (f, Nothing)
+    flip finally (mapM_ removeFile (catMaybes (map snd temps))) $ do
+        mb <- try $ autoReload autoConfig (map fst temps)
+        case mb of
+            Left (err :: SomeException) -> assertFailure (show err)
+            Right (cfg, tid) -> t (map snd temps) cfg >> killThread tid
+
+takeMVarTimeout :: Int -> MVar a -> IO (Maybe a)
+takeMVarTimeout millis v = do
+    w <- newEmptyMVar
+    tid <- forkIO $ do
+        putMVar w . Just =<< takeMVar v
+    forkIO $ do
+        threadDelay (millis * 1000)
+        killThread tid
+        tryPutMVar w Nothing
+        return ()
+    takeMVar w
+
+loadTest :: Assertion
+loadTest = withLoad [Required "pathological.cfg"] $ \cfg -> do
+    aa <- lookup cfg "aa"
+    assertEqual "simple property 1" aa $ Just (1 :: Int)
+
+reloadTest :: Assertion
+reloadTest = withReload [Required "pathological.cfg"] $ \[Just f] cfg -> do
+    aa <- lookup cfg "aa"
+    assertEqual "simple property 1" aa $ Just (1 :: Int)
+
+    dongly <- newEmptyMVar
+    wongly <- newEmptyMVar
+    subscribe cfg "dongly" $ \ _ _ -> putMVar dongly ()
+    subscribe cfg "wongly" $ \ _ _ -> putMVar wongly ()
+    L.appendFile f "\ndongly = 1"
+    r1 <- takeMVarTimeout 2000 dongly
+    assertEqual "notify happened" r1 (Just ())
+    r2 <- takeMVarTimeout 2000 wongly
+    assertEqual "notify not happened" r2 Nothing
+

tests/TestLoad.hs

-{-# LANGUAGE ScopedTypeVariables #-}
-
-import Control.Exception (SomeException, try)
-import Control.Monad (forM_)
-import Data.Configurator
-import System.Environment
-
-main = do
-  args <- getArgs
-  putStrLn $ "files: " ++ show args
-  e <- try $ load (map Required args)
-  case e of
-    Left (err::SomeException) -> putStrLn $ "error: " ++ show err
-    Right c -> putStr "ok: " >> display c

tests/TestReload.hs

-{-# LANGUAGE OverloadedStrings #-}
-
-import Control.Exception
-import Control.Concurrent
-import Data.Configurator
-import Data.Configurator.Types
-import qualified Data.ByteString.Lazy.Char8 as L
-import System.Environment
-import System.Directory
-import Control.Monad
-import System.IO
-
-main = do
-  args <- getArgs
-  tmpDir <- getTemporaryDirectory
-  temps <- forM args $ \arg -> do
-           (p,h) <- openBinaryTempFile tmpDir "test.cfg"
-           L.hPut h =<< L.readFile arg
-           hClose h
-           return p
-  flip finally (mapM_ removeFile temps) $ do
-    done <- newEmptyMVar
-    let myConfig = autoConfig {
-                     onError = \e -> hPutStrLn stderr $ "uh oh: " ++ show e
-                   }
-    (c,_) <- autoReload myConfig (map Required temps)
-    display c
-    subscribe c "dongly" $ \n v -> print (n,v) >> putMVar done ()
-    forM_ temps $ \t -> L.appendFile t "\ndongly = 1\n"
-    takeMVar done

tests/configurator-tests.cabal

+Name:                configurator-tests
+Version:             0.1
+Build-type:          Simple
+Cabal-version:       >=1.2
+
+Executable configurator-test
+  Main-is:           Test.hs
+  Hs-source-dirs:    ., ..
+  Build-depends:     base,
+                     directory,
+                     HUnit,
+                     text,
+                     attoparsec-text,
+                     unordered-containers,
+                     unix-compat,
+                     hashable,
+                     bytestring
+  Ghc-options:       -Wall -fhpc -fno-warn-unused-do-bind

tests/runTests.sh

+#!/bin/sh
+cabal configure
+cabal build
+
+rm -f configurator-test.tix
+./dist/build/configurator-test/configurator-test
+
+HPCDIR=dist/hpc
+
+rm -rf $HPCDIR
+mkdir -p $HPCDIR
+
+EXCLUDES='--exclude=Main'
+hpc markup $EXCLUDES --destdir=$HPCDIR configurator-test
+
+rm -f configurator-test.tix
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.