diff --git a/hbs2-tests/test/TestSKey.hs b/hbs2-tests/test/TestSKey.hs index 983fd7b8..7e05c3f0 100644 --- a/hbs2-tests/test/TestSKey.hs +++ b/hbs2-tests/test/TestSKey.hs @@ -2,12 +2,13 @@ module Main where import HBS2.Net.Proto.Sessions import HBS2.Hash +import HBS2.Clock import Control.Monad import Control.Concurrent.STM import Data.ByteString (ByteString) -import Data.ByteString.Lazy.Char8 as B +import Data.ByteString.Lazy.Char8 qualified as B import Data.Cache (Cache) import Data.Cache qualified as Cache import Data.Map qualified as Map @@ -16,6 +17,7 @@ import System.Random.MWC import System.TimeIt import Test.QuickCheck import Data.HashMap.Strict qualified as HashMap +import Control.Concurrent.Async main :: IO () main = do @@ -27,79 +29,85 @@ main = do bytes <- replicateM 256 $ uniformM g :: IO [Char] pure $ hashObject @HbSync (B.pack bytes) - timeItNamed "Cache (Hash HbSync)" $ do + race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "Cache (Hash HbSync) failed") $ do - replicateM_ 1000 $ do + timeItNamed "Cache (Hash HbSync)" $ do - m1 <- Cache.newCache Nothing :: IO (Cache (Hash HbSync) ()) + replicateM_ 1000 $ do - forM_ ss $ \key -> Cache.insert m1 key () - forM_ ss $ \key -> Cache.lookup' m1 key + m1 <- Cache.newCache Nothing :: IO (Cache (Hash HbSync) ()) + + forM_ ss $ \key -> Cache.insert m1 key () + forM_ ss $ \key -> Cache.lookup' m1 key + + race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "Cache (SKey) failed") $ do + + timeItNamed "Cache (SKey)" $ do + + let keys = fmap newSKey ss + + replicateM_ 1000 $ do + + m1 <- Cache.newCache Nothing + + forM_ keys $ \key -> Cache.insert m1 key () + forM_ keys $ \key -> Cache.lookup' m1 key + + race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "HashMap (Hash HbSync) failed") $ do + + timeItNamed "HashMap (Hash HbSync)" $ do + + let keys = ss + + replicateM_ 1000 $ do + + m1 <- newTVarIO mempty -- .newCache Nothing + + forM_ keys $ \key -> do + atomically $ modifyTVar' m1 (HashMap.insert key ()) + -- Cache.insert m1 key () + + forM_ keys $ \key -> do + m <- readTVarIO m1 + let !x = HashMap.lookup key m + pure () + + race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "HashMap (SKey) failed") $ do + timeItNamed "HashMap (Skey)" $ do + + let keys = fmap newSKey ss + + replicateM_ 1000 $ do + + m1 <- newTVarIO mempty -- .newCache Nothing + + forM_ keys $ \key -> do + atomically $ modifyTVar' m1 (HashMap.insert key ()) + -- Cache.insert m1 key () + + forM_ keys $ \key -> do + m <- readTVarIO m1 + let !x = HashMap.lookup key m + pure () - timeItNamed "Cache (SKey)" $ do + race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "Map (Hash HbSync) failed") $ do + timeItNamed "Map (Hash HbSync)" $ do - let keys = fmap newSKey ss + let keys = ss - replicateM_ 1000 $ do + replicateM_ 1000 $ do - m1 <- Cache.newCache Nothing + m1 <- newTVarIO mempty -- .newCache Nothing - forM_ keys $ \key -> Cache.insert m1 key () - forM_ keys $ \key -> Cache.lookup' m1 key + forM_ keys $ \key -> do + atomically $ modifyTVar' m1 (Map.insert key ()) + -- Cache.insert m1 key () - - timeItNamed "HashMap (Hash HbSync)" $ do - - let keys = ss - - replicateM_ 1000 $ do - - m1 <- newTVarIO mempty -- .newCache Nothing - - forM_ keys $ \key -> do - atomically $ modifyTVar' m1 (HashMap.insert key ()) - -- Cache.insert m1 key () - - forM_ keys $ \key -> do - m <- readTVarIO m1 - let !x = HashMap.lookup key m - pure () - - timeItNamed "HashMap (Skey)" $ do - - let keys = fmap newSKey ss - - replicateM_ 1000 $ do - - m1 <- newTVarIO mempty -- .newCache Nothing - - forM_ keys $ \key -> do - atomically $ modifyTVar' m1 (HashMap.insert key ()) - -- Cache.insert m1 key () - - forM_ keys $ \key -> do - m <- readTVarIO m1 - let !x = HashMap.lookup key m - pure () - - - timeItNamed "Map (Hash HbSync)" $ do - - let keys = ss - - replicateM_ 1000 $ do - - m1 <- newTVarIO mempty -- .newCache Nothing - - forM_ keys $ \key -> do - atomically $ modifyTVar' m1 (Map.insert key ()) - -- Cache.insert m1 key () - - forM_ keys $ \key -> do - m <- readTVarIO m1 - let !x = Map.lookup key m - pure () + forM_ keys $ \key -> do + m <- readTVarIO m1 + let !x = Map.lookup key m + pure () pure ()