Commits

Gideon Sireling committed 3f76f3a

tests: HTF

  • Participants
  • Parent commits 2e765d9

Comments (0)

Files changed (4)

File binding-core/binding-core.cabal

   hs-source-dirs:  src
   exposed-modules: Data.Binding.Simple, Data.Binding.List, Data.Variable
 
-test-suite hunit
-  type:            exitcode-stdio-1.0
-  main-is:         tests/HUnit.hs
-  build-depends:   base, binding-core, random, HUnit
-
-test-suite quickcheck
-  type:            exitcode-stdio-1.0
-  main-is:         tests/QuickCheck.hs
-  build-depends:   base, binding-core, QuickCheck
+test-suite HTF
+  type:           exitcode-stdio-1.0
+  main-is:        HTF.hs
+  build-depends:  base, binding-core, random, HTF, HUnit, QuickCheck
+  hs-source-dirs: tests
 
 source-repository head
   type:     hg

File binding-core/tests/HTF.hs

+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+
+import Test.Framework
+
+import {-@ HTF_TESTS @-} HUnit
+import {-@ HTF_TESTS @-} QuickCheck
+
+main = htfMain htf_importedTests

File binding-core/tests/HUnit.hs

+{-# OPTIONS_GHC -F -pgmF htfpp #-}
 {-# LANGUAGE TupleSections #-}
-import Test.HUnit
+
+module HUnit where
+
+import Test.Framework
+import Test.HUnit.Lang
 
 import Control.Monad
 import Data.IORef
-import System.Exit
 import System.Random
 
 import Data.Binding.List as B
 import Prelude as P
 
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
 -- Change these to exercise different variable and data types
 type V = IORef
 type A = Int
            list <- replicateM size randomIO
            return (list, size)
 
-testRemove' :: Assertion
-testRemove' = do (list, size) <- list'
-                 pos <- randomRIO (0, size-2)
-                 let actual = remove' list pos
-                 assertEqual "List hasn't shrunk correctly" (size-1) (P.length actual)
-                 assertEqual "Head of list incorrect" (take pos list) (take pos actual)
-                 assertEqual "Tail of list incorrect" (drop (pos+1) list) (drop pos actual)
+test_Remove' = do (list, size) <- list'
+                  pos <- randomRIO (0, size-2)
+                  let actual = remove' list pos
+                  assertEqualVerbose "List hasn't shrunk correctly" (size-1) (P.length actual)
+                  assertEqualVerbose "Head of list incorrect" (take pos list) (take pos actual)
+                  assertEqualVerbose "Tail of list incorrect" (drop (pos+1) list) (drop pos actual)
 
-testRemoveLast' :: Assertion
-testRemoveLast' = do (list, size) <- list'
-                     let actual = remove' list (size-1)
-                     assertEqual "List hasn't shrunk correctly" (size-1) (P.length actual)
-                     assertEqual "List is incorrect" (take (size-1) list) actual
+test_RemoveLast' :: Assertion
+test_RemoveLast' = do (list, size) <- list'
+                      let actual = remove' list (size-1)
+                      assertEqualVerbose "List hasn't shrunk correctly" (size-1) (P.length actual)
+                      assertEqualVerbose "List is incorrect" (take (size-1) list) actual
 
-testInsert' :: Assertion
-testInsert' = do (list, size) <- list'
-                 pos <- randomRIO (0, size-1)
-                 new <- randomIO
-                 let actual = insert' list pos new
-                 assertEqual "List hasn't shrunk correctly" (size+1) (P.length actual)
-                 assertEqual "Head of list incorrect" (take pos list) (take pos actual)
-                 assertEqual "Element not inserted" new (actual !! pos)
-                 assertEqual "Tail of list incorrect" (drop pos list) (drop (pos+1) actual)
+test_Insert' :: Assertion
+test_Insert' = do (list, size) <- list'
+                  pos <- randomRIO (0, size-1)
+                  new <- randomIO
+                  let actual = insert' list pos new
+                  assertEqualVerbose "List hasn't shrunk correctly" (size+1) (P.length actual)
+                  assertEqualVerbose "Head of list incorrect" (take pos list) (take pos actual)
+                  assertEqualVerbose "Element not inserted" new (actual !! pos)
+                  assertEqualVerbose "Tail of list incorrect" (drop pos list) (drop (pos+1) actual)
 
 --- *** Test monadic functions ***
 
-testSource :: Assertion
-testSource = do --bind a source
-                expected <- randomIO
-                source <- newVar expected :: IO (Source V A)
-                target <- randomIO >>= newVar :: IO (Source V A)
-                bind source id target writeVar
-                actual <- readVar target
-                assertEqual "Initial Bind" expected actual
-                --change its value
-                expected <- randomIO
-                writeVar source expected
-                actual <- readVar target
-                assertEqual "Value Changed" expected actual
+test_Source :: Assertion
+test_Source = do --bind a source
+                 expected <- randomIO
+                 source <- newVar expected :: IO (Source V A)
+                 target <- randomIO >>= newVar :: IO (Source V A)
+                 bind source id target writeVar
+                 actual <- readVar target
+                 assertEqualVerbose "Initial Bind" expected actual
+                 --change its value
+                 expected <- randomIO
+                 writeVar source expected
+                 actual <- readVar target
+                 assertEqualVerbose "Value Changed" expected actual
 
 -- | Generate a 'BindingList' for testing.
 list :: IO ([A], Int, BindingList V A)
 
 -- | Assert that a 'BindingList' holds the expected list.
 assertList :: [A] -> BindingList V A -> Assertion
-assertList list bl = fromBindingList bl >>= (list @=?)
+assertList list bl = fromBindingList bl >>= assertEqual list
 
 -- | Assert that a 'BindingList' holds the expected list.
 assertPos :: Int -> BindingList V A -> Int -> Assertion
 assertPos expected bl reported = do pos <- position bl
-                                    assertEqual "Wrong positon" expected pos
-                                    assertEqual "Wrong positon reported" pos reported
+                                    assertEqualVerbose "Wrong positon" expected pos
+                                    assertEqualVerbose "Wrong positon reported" pos reported
 
-testList :: Assertion
-testList = do (expected, _, bl) <- list
-              assertList expected bl
+test_List :: Assertion
+test_List = do (expected, _, bl) <- list
+               assertList expected bl
 
-testLength :: Assertion
-testLength = do (_, expected, bl) <- list
-                B.length bl >>= (expected @=?)
+test_Length :: Assertion
+test_Length = do (_, expected, bl) <- list
+                 B.length bl >>= assertEqual expected
 
-testSeek :: Assertion
-testSeek = do (list, size, bl) <- list
-              pos <- randomRIO (0,size-1)
-              seek bl pos >>= assertPos pos bl
-              actual <- readVar bl
-              list !! pos @=? actual
+test_Seek :: Assertion
+test_Seek = do (list, size, bl) <- list
+               pos <- randomRIO (0,size-1)
+               seek bl pos >>= assertPos pos bl
+               actual <- readVar bl
+               assertEqual (list !! pos) actual
 
-testSeekBy :: Assertion
-testSeekBy = do (_, size, bl) <- list
-                init <- randomRIO (0, size-1)
-                offset <- randomRIO (-init, size-init-1)
-                let expected = init + offset
-                seek bl init
-                actual <- seekBy (offset+) bl
-                --give a more detailed error message than assertPos
-                assertEqual ("Seek from " ++ show init ++ " by " ++ show offset) expected actual
-                assertPos expected bl actual
+test_SeekBy :: Assertion
+test_SeekBy = do (_, size, bl) <- list
+                 init <- randomRIO (0, size-1)
+                 offset <- randomRIO (-init, size-init-1)
+                 let expected = init + offset
+                 seek bl init
+                 actual <- seekBy (offset+) bl
+                 --give a more detailed error message than assertPos
+                 assertEqualVerbose ("Seek from " ++ show init ++ " by " ++ show offset) expected actual
+                 assertPos expected bl actual
 
-testNext :: Assertion
-testNext = do (_, size, bl) <- list
-              init <- randomRIO (0, size-2)
-              seek bl init
-              B.next bl >>= assertPos (init+1) bl
+test_Next :: Assertion
+test_Next = do (_, size, bl) <- list
+               init <- randomRIO (0, size-2)
+               seek bl init
+               B.next bl >>= assertPos (init+1) bl
 
-testPrev :: Assertion
-testPrev = do (_, size, bl) <- list
-              init <- randomRIO (1, size-1)
-              seek bl init
-              prev bl >>= assertPos (init-1) bl
+test_Prev :: Assertion
+test_Prev = do (_, size, bl) <- list
+               init <- randomRIO (1, size-1)
+               seek bl init
+               prev bl >>= assertPos (init-1) bl
 
-testRemove :: Assertion
-testRemove = do (list, size, bl) <- list
-                pos <- randomRIO (0, size-2)
-                seek bl pos
-                remove bl >>= assertPos pos bl
-                assertList (remove' list pos) bl
+test_Remove :: Assertion
+test_Remove = do (list, size, bl) <- list
+                 pos <- randomRIO (0, size-2)
+                 seek bl pos
+                 remove bl >>= assertPos pos bl
+                 assertList (remove' list pos) bl
 
-testRemoveLast :: Assertion
-testRemoveLast = do (list, size, bl) <- list
-                    seek bl (size-1)
-                    remove bl >>= assertPos (size-2) bl
-                    assertList (remove' list (size-1)) bl
+test_RemoveLast :: Assertion
+test_RemoveLast = do (list, size, bl) <- list
+                     seek bl (size-1)
+                     remove bl >>= assertPos (size-2) bl
+                     assertList (remove' list (size-1)) bl
 
-testInsert :: Assertion
-testInsert = do (list, size, bl) <- list
-                pos <- randomRIO (0, size-1)
-                new <- randomIO
-                seek bl pos
-                let pos' = pos+1
-                insert bl new >>= assertPos pos' bl
-                assertList (insert' list pos' new) bl
-
-main = do Counts _ _ e f <- runTestTT $ TestList
-             ["Source" ~: testSource
-             ,"binding lists" ~: testList
-             ,"length" ~: testLength
-             ,"seek" ~: testSeek
-             ,"seekBy" ~: testSeekBy
-             ,"next" ~: testNext
-             ,"prev" ~: testPrev
-             ,"remove'" ~: testRemove'
-             ,"remove" ~: testRemove
-             ,"remove' last" ~: testRemoveLast'
-             ,"remove last" ~: testRemoveLast
-             ,"insert'" ~: testInsert'
-             ,"insert" ~: testInsert]
-          when (e>0 || f>0) exitFailure
+test_Insert :: Assertion
+test_Insert = do (list, size, bl) <- list
+                 pos <- randomRIO (0, size-1)
+                 new <- randomIO
+                 seek bl pos
+                 let pos' = pos+1
+                 insert bl new >>= assertPos pos' bl
+                 assertList (insert' list pos' new) bl

File binding-core/tests/QuickCheck.hs

-{-# LANGUAGE TupleSections, TemplateHaskell #-}
-import Test.QuickCheck
-import Test.QuickCheck.Modifiers
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+{-# LANGUAGE TupleSections #-}
+
+module QuickCheck where
+
+import Test.Framework
 import Test.QuickCheck.Monadic
-import Test.QuickCheck.All
-import Test.QuickCheck.Test
 
 import Control.Monad
 import Data.IORef
-import System.Exit
 
 import Data.Binding.List as B
 import Prelude as P
 
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
 -- Change these to exercise different variable and data types
 type V = IORef
 type A = Char
 
 -- *** Test pure functions ***
 
-prop_remove' :: [A] -> Int -> Bool
-prop_remove' xs i = let pos = anywhere i xs
-                        actual = remove' xs pos
-                    in P.length actual == P.length xs - 1
-                    && take pos actual == take pos xs
-                    && drop (pos+1) xs == drop pos actual
+prop_remove' :: NonEmptyList A -> Int -> Bool
+prop_remove' (NonEmpty xs) i = let pos = anywhere i xs
+                                   actual = remove' xs pos
+                               in P.length actual == P.length xs - 1
+                               && take pos actual == take pos xs
+                               && drop (pos+1) xs == drop pos actual
 
-prop_removeLast' :: [A] -> Bool
-prop_removeLast' xs = let pos = P.length xs - 1
-                          actual = remove' xs pos
-                      in P.length actual == pos
-                      && actual == take pos xs
+prop_removeLast' :: NonEmptyList A -> Bool
+prop_removeLast' (NonEmpty xs) = let pos = P.length xs - 1
+                                     actual = remove' xs pos
+                                 in P.length actual == pos
+                                 && actual == take pos xs
 
-prop_insert' :: [A] -> Int -> A -> Bool
-prop_insert' xs i x = let pos = anywhere i xs
-                          actual = insert' xs pos x
-                      in P.length actual == P.length xs + 1
-                      && take pos actual == take pos xs
-                      && actual !! pos == x
-                      && drop pos actual == drop (pos+1) xs
+prop_insert' :: NonEmptyList A -> Int -> A -> Bool
+prop_insert' (NonEmpty xs) i x = let pos = anywhere i xs
+                                     actual = insert' xs pos x
+                                 in P.length actual == P.length xs + 1
+                                 && take pos actual == take pos xs
+                                 && actual !! pos == x
+                                 && drop pos xs == drop (pos+1) actual
 
 -- *** QuickCheck 'Property's for Monadic actions. ***
 
    new <- run $ list xs pos >>= position
    assert (new == pos)
 
-prop_seekBy :: List -> Int -> Int -> Property
-prop_seekBy (List xs) a b = let size = P.length xs
-                                init = anywhere a xs
-                                offset = anywhere b xs - init
-                            in monadicIO $ do
+prop_seekBy :: NonEmptyList A -> Int -> Int -> Property
+prop_seekBy (NonEmpty xs) a b = let init = anywhere a xs
+                                    offset = anywhere b xs - init
+                                in monadicIO $ do
    (new, x) <- run $ do bl <- list xs init
                         liftM2 (,) (seekBy (offset+) bl) (readVar bl)
    assert (new == init + offset && x == xs !! new)
                         liftM2 (,) (prev bl) (readVar bl)
    assert (new == pos - 1 && x == xs !! new)
 
-prop_insert :: List -> Int -> A -> Property
-prop_insert (List xs) i x = let pos = anywhere i xs
-                                new = pos + 1
-                            in monadicIO $ do
+prop_insert :: NonEmptyList A -> Int -> A -> Property
+prop_insert (NonEmpty xs) i x = let pos = anywhere i xs
+                                    new = pos + 1
+                                in monadicIO $ do
    (pos', ys) <- run $ do bl <- list xs pos
                           liftM2 (,) (insert bl x) (fromBindingList bl)
    assert (ys == insert' xs new x && pos' == new)
 prop_removeLast :: List -> Property
 prop_removeLast (List xs) = let pos = P.length xs - 1 in monadicIO $ do
    (pos', ys) <- testRemove xs pos
-   assert (ys == remove' xs pos && pos' == pos -1)
-
--- | Test the 'Property's
-main = do passed <- $quickCheckAll
-          unless passed exitFailure
+   assert (ys == remove' xs pos && pos' == pos -1)