summaryrefslogtreecommitdiff
path: root/tests/Data/Graph/Dynamic/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Data/Graph/Dynamic/Internal')
-rw-r--r--tests/Data/Graph/Dynamic/Internal/Avl/Tests.hs22
-rw-r--r--tests/Data/Graph/Dynamic/Internal/Random/Tests.hs22
-rw-r--r--tests/Data/Graph/Dynamic/Internal/Splay/Tests.hs22
-rw-r--r--tests/Data/Graph/Dynamic/Internal/Tree/Tests.hs121
4 files changed, 187 insertions, 0 deletions
diff --git a/tests/Data/Graph/Dynamic/Internal/Avl/Tests.hs b/tests/Data/Graph/Dynamic/Internal/Avl/Tests.hs
new file mode 100644
index 0000000..156e494
--- /dev/null
+++ b/tests/Data/Graph/Dynamic/Internal/Avl/Tests.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Data.Graph.Dynamic.Internal.Avl.Tests
+ ( tests
+ ) where
+
+import qualified Data.Graph.Dynamic.Internal.Avl as Avl
+import qualified Data.Graph.Dynamic.Internal.Tree.Tests as Class
+import Data.Monoid (Sum)
+import Data.Proxy (Proxy (..))
+import Test.Framework (Test)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Framework.TH (testGroupGenerator)
+import qualified Test.QuickCheck as QC
+
+prop_append :: Class.BuildTree Int (Sum Int) -> QC.Property
+prop_append = Class.prop_build (Proxy :: Proxy Avl.Tree)
+
+prop_split :: Int -> Class.BuildTree Int () -> QC.Property
+prop_split = Class.prop_split (Proxy :: Proxy Avl.Tree)
+
+tests :: Test
+tests = $(testGroupGenerator)
diff --git a/tests/Data/Graph/Dynamic/Internal/Random/Tests.hs b/tests/Data/Graph/Dynamic/Internal/Random/Tests.hs
new file mode 100644
index 0000000..b8986a5
--- /dev/null
+++ b/tests/Data/Graph/Dynamic/Internal/Random/Tests.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Data.Graph.Dynamic.Internal.Random.Tests
+ ( tests
+ ) where
+
+import qualified Data.Graph.Dynamic.Internal.Random as Random
+import qualified Data.Graph.Dynamic.Internal.Tree.Tests as Class
+import Data.Monoid (Sum)
+import Data.Proxy (Proxy (..))
+import Test.Framework (Test)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Framework.TH (testGroupGenerator)
+import qualified Test.QuickCheck as QC
+
+prop_append :: Class.BuildTree Int (Sum Int) -> QC.Property
+prop_append = Class.prop_build (Proxy :: Proxy Random.Tree)
+
+prop_split :: Int -> Class.BuildTree Int (Sum Int) -> QC.Property
+prop_split = Class.prop_split (Proxy :: Proxy Random.Tree)
+
+tests :: Test
+tests = $(testGroupGenerator)
diff --git a/tests/Data/Graph/Dynamic/Internal/Splay/Tests.hs b/tests/Data/Graph/Dynamic/Internal/Splay/Tests.hs
new file mode 100644
index 0000000..767f9e2
--- /dev/null
+++ b/tests/Data/Graph/Dynamic/Internal/Splay/Tests.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Data.Graph.Dynamic.Internal.Splay.Tests
+ ( tests
+ ) where
+
+import qualified Data.Graph.Dynamic.Internal.Splay as Splay
+import qualified Data.Graph.Dynamic.Internal.Tree.Tests as Class
+import Data.Monoid (Sum)
+import Data.Proxy (Proxy (..))
+import Test.Framework (Test)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Framework.TH (testGroupGenerator)
+import qualified Test.QuickCheck as QC
+
+prop_append :: Class.BuildTree Int (Sum Int) -> QC.Property
+prop_append = Class.prop_build (Proxy :: Proxy Splay.Tree)
+
+prop_split :: Int -> Class.BuildTree Int (Sum Int) -> QC.Property
+prop_split = Class.prop_split (Proxy :: Proxy Splay.Tree)
+
+tests :: Test
+tests = $(testGroupGenerator)
diff --git a/tests/Data/Graph/Dynamic/Internal/Tree/Tests.hs b/tests/Data/Graph/Dynamic/Internal/Tree/Tests.hs
new file mode 100644
index 0000000..c3f7b27
--- /dev/null
+++ b/tests/Data/Graph/Dynamic/Internal/Tree/Tests.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Data.Graph.Dynamic.Internal.Tree.Tests
+ ( BuildTree
+ , prop_build
+ , prop_split
+ ) where
+
+import Control.Monad.Primitive (PrimMonad (..))
+import Control.Monad.ST (runST)
+import Data.Graph.Dynamic.Internal.Tree
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Proxy (Proxy)
+import Data.Semigroup ((<>))
+import qualified Test.QuickCheck as QC
+
+data BuildTree a v
+ = Singleton a v
+ | Append (BuildTree a v) (BuildTree a v)
+ | Snoc (BuildTree a v) a v
+ | Cons a v (BuildTree a v)
+ deriving (Show)
+
+arbitraryBuildTree
+ :: (QC.Arbitrary a, QC.Arbitrary v) => Int -> QC.Gen (BuildTree a v)
+arbitraryBuildTree n
+ | n <= 0 = Singleton <$> QC.arbitrary <*> QC.arbitrary
+ | otherwise = QC.oneof
+ [ Singleton <$> QC.arbitrary <*> QC.arbitrary
+ , Append <$> arbitraryBuildTree (n - 1) <*> arbitraryBuildTree (n - 1)
+ , Snoc <$> arbitraryBuildTree (n - 1) <*> QC.arbitrary <*> QC.arbitrary
+ , Cons <$> QC.arbitrary <*> QC.arbitrary <*> arbitraryBuildTree (n - 1)
+ ]
+
+instance (QC.Arbitrary a, QC.Arbitrary v) => QC.Arbitrary (BuildTree a v) where
+ arbitrary = QC.sized arbitraryBuildTree
+
+ shrink (Singleton _ _) = []
+ shrink (Snoc l a v) = [l] ++ [Snoc l' a v | l' <- QC.shrink l]
+ shrink (Cons a v r) = [r] ++ [Cons a v r' | r' <- QC.shrink r]
+ shrink (Append l r) =
+ [l, r] ++
+ [Append l' r | l' <- QC.shrink l] ++
+ [Append l r' | r' <- QC.shrink r]
+
+-- | Returns pointers to all nodes.
+appendsToTree
+ :: (Tree t, PrimMonad m, Monoid v)
+ => Proxy t
+ -> TreeGen t (PrimState m)
+ -> BuildTree a v
+ -> m (t (PrimState m) a v, NonEmpty (t (PrimState m) a v))
+appendsToTree _proxy gen = go
+ where
+ go (Singleton a v) = do
+ s <- singleton gen a v
+ return (s, s NonEmpty.:| [])
+ go (Snoc b a v) = do
+ (l, lps) <- go b
+ s <- singleton gen a v
+ rt <- l `snoc` s
+ return (rt, lps <> (s NonEmpty.:| []))
+ go (Cons a v b) = do
+ s <- singleton gen a v
+ (r, rps) <- go b
+ rt <- s `cons` r
+ return (rt, (s NonEmpty.:| []) <> rps)
+ go (Append bl br) = do
+ (l, lps) <- go bl
+ (r, rps) <- go br
+ rt <- append l r
+ return (rt, lps <> rps)
+
+appendsToList :: BuildTree a v -> [a]
+appendsToList (Singleton a _) = [a]
+appendsToList (Snoc l a _) = appendsToList l ++ [a]
+appendsToList (Cons a _ r) = [a] ++ appendsToList r
+appendsToList (Append l r) = appendsToList l ++ appendsToList r
+
+prop_build
+ :: (TestTree t, Eq a, Show a, Eq v, Monoid v, Show v)
+ => Proxy t -> BuildTree a v -> QC.Property
+prop_build proxy appends = runST $ do
+ gen <- newTreeGen proxy
+ (t, _) <- appendsToTree proxy gen appends
+ assertInvariants t
+
+ l <- toList t
+ return $ l QC.=== appendsToList appends
+
+prop_split
+ :: (TestTree t, Eq a, Show a, Eq v, Monoid v, Show v)
+ => Proxy t -> Int -> BuildTree a v -> QC.Property
+prop_split proxy idx0 appends = runST $ do
+ gen <- newTreeGen proxy
+ (_t, ptrs) <- appendsToTree proxy gen appends
+ let idx = idx0 `mod` NonEmpty.length ptrs
+ ptr = ptrs NonEmpty.!! idx
+
+ (mbL, mbR) <- split ptr
+ case mbL of
+ Just l -> do
+ assertInvariants l
+ assertRoot l
+ _ -> return ()
+
+ case mbR of
+ Just r -> do
+ assertInvariants r
+ assertRoot r
+ _ -> return ()
+
+ assertInvariants ptr
+ assertSingleton ptr
+
+ lList <- maybe (return []) toList mbL
+ cList <- toList ptr
+ rList <- maybe (return []) toList mbR
+
+ return $ lList ++ cList ++ rList QC.=== appendsToList appends