stm-containers 1.2.1.1 → 1.2.2
raw patch · 6 files changed
+140/−7 lines, 6 filesdep ~stm-hamtPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: stm-hamt
API changes (from Hackage documentation)
+ StmContainers.Set: listTNonAtomic :: Set item -> ListT IO item
Files
- library/StmContainers/Bimap.hs +0/−1
- library/StmContainers/Multimap.hs +0/−1
- library/StmContainers/Set.hs +8/−1
- stm-containers.cabal +4/−3
- test/Main.hs +3/−1
- test/Suites/Set.hs +125/−0
library/StmContainers/Bimap.hs view
@@ -30,7 +30,6 @@ -- of the right-hand type and vice versa. data Bimap leftKey rightKey = Bimap !(A.Map leftKey rightKey) !(A.Map rightKey leftKey)- deriving (Typeable) -- | -- Construct a new bimap.
library/StmContainers/Multimap.hs view
@@ -30,7 +30,6 @@ -- Basically it's just a wrapper API around @'A.Map' key ('B.Set' value)@. newtype Multimap key value = Multimap (A.Map key (B.Set value))- deriving (Typeable) -- | -- Construct a new multimap.
library/StmContainers/Set.hs view
@@ -11,6 +11,7 @@ reset, unfoldlM, listT,+ listTNonAtomic, ) where @@ -22,7 +23,6 @@ -- A hash set, based on an STM-specialized hash array mapped trie. newtype Set item = Set (A.SizedHamt item)- deriving (Typeable) -- | -- Construct a new set.@@ -114,3 +114,10 @@ listT :: Set item -> ListT STM item listT (Set hamt) = A.listT hamt++-- |+-- Stream the elements passively.+-- Data may be inconsistent/out of date.+{-# INLINE listTNonAtomic #-}+listTNonAtomic :: Set item -> ListT IO item+listTNonAtomic (Set hamt) = A.listTNonAtomic hamt
stm-containers.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: stm-containers-version: 1.2.1.1+version: 1.2.2 synopsis: Containers for STM description: This library is based on an STM-specialized implementation of@@ -24,7 +24,7 @@ source-repository head type: git- location: git://github.com/nikita-volkov/stm-containers.git+ location: https://github.com/nikita-volkov/stm-containers library hs-source-dirs: library@@ -82,7 +82,7 @@ focus >=1.0.1.4 && <1.1, hashable >=1.4 && <2, list-t >=1.0.1 && <1.1,- stm-hamt >=1.2.1 && <1.3,+ stm-hamt >=1.2.2 && <1.3, transformers >=0.5 && <0.7, test-suite test@@ -134,6 +134,7 @@ Suites.Bimap Suites.Map Suites.Map.Update+ Suites.Set build-depends: deferred-folds,
test/Main.hs view
@@ -1,5 +1,6 @@ import qualified Suites.Bimap import qualified Suites.Map+import qualified Suites.Set import Test.Tasty import Prelude @@ -8,5 +9,6 @@ defaultMain . testGroup "" $ [ testGroup "Bimap" Suites.Bimap.tests,- testGroup "Map" Suites.Map.tests+ testGroup "Map" Suites.Map.tests,+ testGroup "Set" Suites.Set.tests ]
+ test/Suites/Set.hs view
@@ -0,0 +1,125 @@+module Suites.Set (tests) where++import Control.Concurrent.STM+import qualified Control.Foldl as Foldl+import Control.Monad (forM_)+import Control.Monad.Free+import Data.Hashable+import Data.List (nub, sort, splitAt)+import Data.Word (Word8)+import qualified DeferredFolds.UnfoldlM as UnfoldlM+import qualified Focus+import qualified ListT+import qualified StmContainers.Set as StmSet+import System.IO.Unsafe (unsafePerformIO)+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Prelude hiding (choose, null)++-- helpers++stmSetFromList :: (Hashable a, Eq a) => [a] -> STM (StmSet.Set a)+stmSetFromList xs = do+ s <- StmSet.new+ forM_ xs $ \x -> StmSet.insert x s+ return s++stmSetToList :: StmSet.Set a -> STM [a]+stmSetToList = UnfoldlM.foldM (Foldl.generalize Foldl.list) . StmSet.unfoldlM++-- * Intentional hash collision simulation++newtype TestKey = TestKey Word8+ deriving (Eq, Ord, Show)++instance Arbitrary TestKey where+ arbitrary = TestKey <$> choose (0, 63)++instance Hashable TestKey where+ hashWithSalt salt (TestKey w) =+ if odd w+ then hashWithSalt salt (pred w)+ else hashWithSalt salt w++-- * Tests++tests :: [TestTree]+tests =+ [ testProperty "sizeAndList"+ $ let gen = nub <$> listOf (choose ('a', 'z'))+ prop xs =+ length xs == stmSetSize+ where+ stmSetSize =+ unsafePerformIO $ atomically $ do+ s <- stmSetFromList xs+ StmSet.size s+ in forAll gen prop,+ testProperty "fromListToListSetIsomorphism" $ \(xs :: [Int]) ->+ let setList =+ unsafePerformIO+ $ atomically+ $ stmSetFromList xs+ >>= stmSetToList+ in sort (nub xs) === sort setList,+ testProperty "listTNonAtomicIsomorphism" $ \(xs :: [Int]) ->+ let setList =+ unsafePerformIO $ do+ set <- atomically (stmSetFromList xs)+ ListT.toList (StmSet.listTNonAtomic set)+ in sort (nub xs) === sort setList,+ testProperty "insertDeleteWithCollisions" $ \(ks :: [TestKey]) ->+ let dropped = take (length ks `div` 2) ks+ (finalSize, finalList) =+ unsafePerformIO $ atomically $ do+ s <- StmSet.new+ -- insert all+ forM_ ks $ \k -> StmSet.insert k s+ -- delete ~the first half of them+ forM_ dropped $ \k -> StmSet.delete k s+ sz <- StmSet.size s+ ls <- stmSetToList s+ return (sz, sort ls)+ expected =+ let remaining = nub (filter (`notElem` dropped) ks)+ in (length remaining, sort remaining)+ in (finalSize, finalList) === expected,+ testCase "insert"+ $ assertEqual "" (sort ['a', 'b', 'c'])+ =<< do+ atomically $ do+ s <- StmSet.new+ StmSet.insert 'a' s+ StmSet.insert 'c' s+ StmSet.insert 'b' s+ sort <$> stmSetToList s,+ testCase "focusInsert"+ $ assertEqual "" (sort ['a', 'b'])+ =<< do+ atomically $ do+ s <- StmSet.new+ StmSet.focus (Focus.insert ()) 'a' s+ StmSet.focus (Focus.insert ()) 'b' s+ sort <$> stmSetToList s,+ testCase "insertAndDelete"+ $ assertEqual "" ['b']+ =<< do+ atomically $ do+ s <- StmSet.new+ StmSet.focus (Focus.insert ()) 'a' s+ StmSet.focus (Focus.insert ()) 'b' s+ StmSet.focus Focus.delete 'a' s+ sort <$> stmSetToList s,+ testCase "nullAndNotNull" $ do+ assertEqual "" True =<< atomically (StmSet.null =<< StmSet.new)+ assertEqual "" False =<< atomically (StmSet.null =<< stmSetFromList ['a']),+ testCase "nullAfterDeletingTheLastElement"+ $ assertEqual "" True+ =<< do+ atomically $ do+ s <- stmSetFromList ['a']+ StmSet.delete 'a' s+ StmSet.null s+ ]