Skip to content
Browse files

Convert tests to HUnit with HPC

  • Loading branch information...
1 parent 866fdf6 commit 70e5121c48f5bc29d78b3709f7eff78f05286c3b @cdsmith cdsmith committed
Showing with 123 additions and 44 deletions.
  1. +2 −0 tests/Setup.hs
  2. +87 −0 tests/Test.hs
  3. +0 −14 tests/TestLoad.hs
  4. +0 −30 tests/TestReload.hs
  5. +18 −0 tests/configurator-tests.cabal
  6. +16 −0 tests/runTests.sh
View
2 tests/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
View
87 tests/Test.hs
@@ -0,0 +1,87 @@
+{-# 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
+
View
14 tests/TestLoad.hs
@@ -1,14 +0,0 @@
-{-# 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
View
30 tests/TestReload.hs
@@ -1,30 +0,0 @@
-{-# 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
View
18 tests/configurator-tests.cabal
@@ -0,0 +1,18 @@
+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
View
16 tests/runTests.sh
@@ -0,0 +1,16 @@
+#!/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

0 comments on commit 70e5121

Please sign in to comment.
Something went wrong with that request. Please try again.