Merge pull request #290 from tweag/unifying-tests

Unifying testing frameworks

Author: Divesh Otwani

examples/Main.hs

@@ -0,0 +1,15 @@
+module Main where
+
+import Test.Tasty
+import Test.Foreign (foreignGCTests)
+import Test.Quicksort (quickSortTests)
+
+main :: IO ()
+main = defaultMain allTests
+
+allTests :: TestTree
+allTests = testGroup "All tests"
+  [ foreignGCTests
+  , quickSortTests
+  ]
+

examples/Simple/Quicksort.hs

@@ -2,26 +2,14 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | This module implements quicksort with mutable arrays from linear-base
-module Simple.Quicksort
-  ( testQuicksort
-  , quickSort
-  )
-where
+module Simple.Quicksort (quickSort) where
 
 import GHC.Stack
 import qualified Data.Array.Mutable.Linear as Array
 import Data.Array.Mutable.Linear (Array)
 import Data.Unrestricted.Linear
 import Prelude.Linear hiding (partition)
 
-
--- # Testing
--------------------------------------------------------------------------------
-
-testQuicksort :: [Int] -> Bool
-testQuicksort xs = sort xs == quickSort xs
-
-
 -- # Quicksort
 -------------------------------------------------------------------------------
 

examples/Simple/TopSort.hs

@@ -16,29 +16,6 @@ import Data.HashMap.Mutable.Linear (HashMap)
 import Data.Bifunctor.Linear (second)
 import Data.Maybe.Linear (catMaybes)
 import qualified Data.Functor.Linear as Data
-import Test.HUnit hiding (Node)
-
-
--- # All Tests
--------------------------------------------------------------------------------
-
-test1 :: Test
-test1 = topsort [(1,[2,3]), (2, [4]), (3,[4]), (4,[])] ~=?
-  [1,2,3,4]
-
-test2 :: Test
-test2 = topsort [(5,[2,0]), (4,[0,1]), (0,[]), (2,[3]), (3,[1]), (1,[])] ~=?
-  [5,2,3,4,0,1]
-
-test3 :: Test
-test3 = topsort
-  [ (1,[2]), (2,[4,5]), (3,[9,7]), (4,[7,8,10]), (5,[10]), (6,[10])
-  , (7,[]),(8,[]),(9,[]),(10,[])
-  ] ~=?
-    [1,2,4,8,5,3,9,7,6,10]
-
-topsortTests :: IO Counts
-topsortTests = runTestTT  $ TestList [test1, test2, test3]
 
 -- # The topological sort of a DAG
 -------------------------------------------------------------------------------

examples/Spec.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Foreign (foreignGCTests) where
+
+import Data.Typeable
+import Control.Monad (void)
+import Control.Exception hiding (assert)
+import qualified Foreign.Heap as Heap
+import Foreign.List (List)
+import qualified Foreign.List as List
+import qualified Foreign.Marshal.Pure as Manual
+import qualified Prelude
+import Prelude.Linear
+import Test.Tasty
+import Test.Tasty.Hedgehog (testProperty)
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+
+
+-- # Organizing tests
+-------------------------------------------------------------------------------
+
+foreignGCTests :: TestTree
+foreignGCTests = testGroup "foreignGCTests"
+  [ listExampleTests
+  , heapExampleTests
+  ]
+
+listExampleTests :: TestTree
+listExampleTests = testGroup "list tests"
+  [ testProperty "List.toList . List.fromList = id" invertNonGCList
+  , testProperty "map id = id" mapIdNonGCList
+  , testProperty "memory freed post-exception" testExecptionOnMem
+  ]
+
+heapExampleTests :: TestTree
+heapExampleTests = testGroup "heap tests"
+  [ testProperty "sort = heapsort" nonGCHeapSort ]
+
+
+-- # Internal library
+-------------------------------------------------------------------------------
+
+list :: Gen [Int]
+list = Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 100))
+
+eqList :: forall a. (Manual.Representable a, Movable a, Eq a) =>
+  List a %1-> List a %1-> Ur Bool
+eqList l1 l2 = move $ (List.toList l1) == (List.toList l2)
+
+data InjectedError = InjectedError
+  deriving (Typeable, Show)
+
+instance Exception InjectedError
+
+
+-- # Properties
+-------------------------------------------------------------------------------
+
+invertNonGCList :: Property
+invertNonGCList = property Prelude.$ do
+  xs <- forAll list
+  let xs' = unur $
+        Manual.withPool (\p -> move $ List.toList $ List.ofList xs p)
+  xs === xs'
+
+mapIdNonGCList :: Property
+mapIdNonGCList = property Prelude.$ do
+  xs <- forAll list
+  let boolTest = unur $ Manual.withPool $ \p ->
+        dup3 p & \(p0,p1,p2) ->
+          eqList (List.ofList xs p0) (List.map id (List.ofList xs p1) p2)
+  assert boolTest
+
+testExecptionOnMem :: Property
+testExecptionOnMem = property Prelude.$ do
+  xs <- forAll list
+  let bs = xs ++ (throw InjectedError)
+  let writeBadList = Manual.withPool (move . List.toList . List.ofRList bs)
+  let ignoreCatch = \_ -> Prelude.return ()
+  evalIO (catch @InjectedError (void (evaluate writeBadList)) ignoreCatch)
+
+nonGCHeapSort :: Property
+nonGCHeapSort = property Prelude.$ do
+  xs <- forAll list
+  let ys :: [(Int,())] = zip xs $ Prelude.replicate (Prelude.length xs) ()
+  (Heap.sort ys) === (reverse $ sort ys)
+

examples/Test/Foreign.hs

@@ -0,0 +1,18 @@
+module Test.Quicksort (quickSortTests) where
+
+import Data.List (sort)
+import Simple.Quicksort (quickSort)
+import Test.Tasty
+import Test.Tasty.Hedgehog (testProperty)
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+
+quickSortTests :: TestTree
+quickSortTests = testProperty "quicksort sorts" testQuicksort
+
+testQuicksort :: Property
+testQuicksort = property $ do
+  xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int $ Range.linear 0 100)
+  sort xs === quickSort xs
+

examples/Test/Quicksort.hs

@@ -99,12 +99,14 @@ library
 test-suite test
   type: exitcode-stdio-1.0
   hs-source-dirs: test
-  main-is: Spec.hs
+  main-is: Main.hs
   other-modules:
+    Test.Data.Destination
     Test.Data.Mutable.Array
     Test.Data.Mutable.Vector
     Test.Data.Mutable.HashMap
     Test.Data.Mutable.Set
+    Test.Data.Polarized
   build-depends:
     base,
     linear-base,
@@ -120,8 +122,10 @@ test-suite test
 test-suite examples
   type: exitcode-stdio-1.0
   hs-source-dirs: examples
-  main-is: Spec.hs
+  main-is: Main.hs
   other-modules:
+    Test.Foreign
+    Test.Quicksort
     Foreign.List
     Foreign.Heap
     Simple.FileIO
@@ -130,10 +134,10 @@ test-suite examples
     Simple.TopSort
   build-depends:
     base,
-    hspec,
-    HUnit,
     linear-base,
-    QuickCheck,
+    tasty,
+    tasty-hedgehog,
+    hedgehog,
     storable-tuple,
     vector,
     text