expiring-cache-map 0.0.5.4 → 0.0.6.0

raw patch · 11 files changed

+1288/−16 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Caching/ExpiringCacheMap/HashECM.hs +85/−4
• Caching/ExpiringCacheMap/Internal/Internal.hs +18/−1
• Caching/ExpiringCacheMap/OrdECM.hs +84/−4
• expiring-cache-map.cabal +6/−1
• tests/TestECMWithTestSequenceCommonInvalidating.hs +683/−0
• tests/TestHashECMWithTestSequenceInvalidating.hs +85/−0
• tests/TestHashECMWithThreadsInvalidating.hs +118/−0
• tests/TestOrdECMWithTestSequenceInvalidating.hs +84/−0
• tests/TestOrdECMWithThreadsInvalidating.hs +116/−0
• tests/TestWithTestSequence.hs +5/−2
• tests/TestWithThreads.hs +4/−4

@@ -57,12 +57,16 @@     lookupECM,
     
     -- * Value request function state
-    -- putValReqState,
     getValReqState,
     
-    -- -- * Clear cache
-    -- clearCache,
+    -- * Invalidate cache
+    invalidate,
+    invalidateCache,
     
+    -- * List keys
+    keysCached,
+    keysNotExpired,
+    
     -- * Type
     ECM,
     CacheSettings(..)
@@ -73,7 +77,7 @@ import qualified Data.List as L
 import Data.Hashable (Hashable(..))
 
-import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM)
+import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM, detNotExpired)
 import Caching.ExpiringCacheMap.Types
 import Caching.ExpiringCacheMap.Internal.Types
 
@@ -216,6 +220,83 @@   where
   
     ECM ( m'maps, _, _, _, _, _, _, _, read ) = ecm
+
+
+-- | Invalidates a key from the cache and returns its value if any.
+--   Note this is a sequential composition of a read and modify of the
+--   mutable cache container (readMVar and modifyMVar with newECMIO).
+--
+invalidate :: (Monad m, Eq k, Hashable k) => ECM m mv s HM.HashMap k v -> k -> m (Maybe v)
+invalidate ecm id = do
+  CacheState (_, maps0, _, _, _) <- read m'maps
+  case HM.lookup id maps0 of
+    Just time_prev0 -> do
+      prev0' <- enter m'maps $
+        \(CacheState (retr_state, maps, mapsize, uses, incr)) ->
+          let (_, _, prev) =
+                case HM.lookup id maps of
+                  Just time_prev -> time_prev
+                  Nothing -> time_prev0
+              maps' = HM.delete id maps
+           in return (CacheState (retr_state, maps', mapsize, uses, incr), prev)
+      return $ Just prev0'
+    Nothing -> return Nothing
+  where
+    ECM ( m'maps, _, _, _, _, _, compactlistsize, enter, read ) = ecm
+
+
+-- | Invalidates the entire cache and returns the last key and value if any.
+--   Note this is a sequential composition of a read and modify of the
+--   mutable cache container (readMVar and modifyMVar with newECMIO).
+--
+invalidateCache :: (Monad m, Eq k, Hashable k) => ECM m mv s HM.HashMap k v -> m (Maybe (k, v))
+invalidateCache ecm = do
+  CacheState (_, maps0, _, (uses0, _), _) <- read m'maps
+  case (HM.toList $ HM.intersection (HM.fromList uses0) maps0) of
+    [] -> return Nothing
+    uses0' -> 
+      let (id, _) = L.maximumBy (\(_,a) (_,b) -> compare a b) uses0' in
+      case HM.lookup id maps0 of
+        Just time_prev0 -> do
+          prev0' <- enter m'maps $
+            \(CacheState (retr_state, maps, _mapsize, _uses, _incr)) ->
+              let (_, _, prev) =
+                    case HM.lookup id maps of
+                      Just time_prev -> time_prev
+                      Nothing -> time_prev0
+               in return (CacheState (retr_state, HM.empty, 0, ([], 0), 0), prev)
+          return $ Just (id, prev0')
+  where
+    ECM ( m'maps, _, _, _, _, _, compactlistsize, enter, read ) = ecm
+
+
+-- | List of keys in the cache map, which can contain expired values, since
+--   the list is returned without performing a time check. keys are in an
+--   unspecified order.
+--
+keysCached :: (Monad m, Eq k, Hashable k) => ECM m mv s HM.HashMap k v -> m [k]
+keysCached ecm = do
+  CacheState (_, maps0, _, _, _) <- read m'maps
+  return $ HM.keys maps0
+  where
+    ECM ( m'maps, _, _, _, _, _, _, _, read ) = ecm
+
+
+-- | List of keys in the cache map that are not expired values. A time check
+--   is always performed to compare the elapsed time and the cache state is not
+--   modified. The time check is not performed from within a modifying state
+--   context, e.g. not within modifyMVar with a newECMIO instance. Keys are in an
+--   unspecified order. 
+--
+keysNotExpired :: (Monad m, Eq k, Hashable k) => ECM m mv s HM.HashMap k v -> m [k]
+keysNotExpired ecm = do
+  CacheState (_, maps0, _, _, _) <- read m'maps
+  current_time <- gettime
+  return $ detNotExpired current_time $ HM.toList maps0
+  where
+    ECM ( m'maps, _, gettime, _, _, _, _, _, read ) = ecm
+
+
 
 {-
 

@@ -14,7 +14,8 @@ module Caching.ExpiringCacheMap.Internal.Internal (
     updateUses,
     detECM,
-    getStatsString
+    getStatsString,
+    detNotExpired
 ) where
 
 import qualified Data.List as L
@@ -169,6 +170,20 @@                    (accesstime > (time - expirytime)))
 
 
+detNotExpired
+ :: TimeUnits -> [(k, (TimeUnits, TimeUnits, v))] -> [k]
+{-# INLINE detNotExpired #-}
+detNotExpired _time l = detNotExpired' _time l []
+
+{-# INLINE detNotExpired' #-}
+detNotExpired' _time [] l = reverse l
+detNotExpired'  time ((key, (accesstime, expirytime, _value)) : r) l
+  | (accesstime <= time) && (accesstime > (time - expirytime)) =
+        detNotExpired' time r (key:l)
+  | otherwise =
+        detNotExpired' time r l
+
+
 -- | Debugging function
 --
 getStatsString ecm = do
@@ -177,4 +192,6 @@   where
     ECM ( m'uses, _retr, _gettime, _minimumkeep, _timecheckmodulo, _removalsize,
           _compactlistsize, _enter, ro ) = ecm
+
+
 

@@ -56,12 +56,16 @@     lookupECM,
     
     -- * Value request function state
-    -- putValReqState,
     getValReqState,
     
-    -- -- * Clear cache
-    -- clearCache,
+    -- * Invalidate cache
+    invalidate,
+    invalidateCache,
     
+    -- * List keys
+    keysCached,
+    keysNotExpired,
+    
     -- * Type
     ECM,
     CacheSettings(..)
@@ -71,7 +75,7 @@ import qualified Data.Map.Strict as M
 import qualified Data.List as L
 
-import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM)
+import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM, detNotExpired)
 import Caching.ExpiringCacheMap.Types
 import Caching.ExpiringCacheMap.Internal.Types
 
@@ -212,6 +216,82 @@   return retr_state
   where
     ECM ( m'maps, _, _, _, _, _, _, _, read ) = ecm
+
+
+-- | Invalidates a key from the cache and returns its value if any.
+--   Note this is a sequential composition of a read and modify of the
+--   mutable cache container (readMVar and modifyMVar with newECMIO).
+--
+invalidate :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m (Maybe v)
+invalidate ecm id = do
+  CacheState (_, maps0, _, _, _) <- read m'maps
+  case M.lookup id maps0 of
+    Just time_prev0 -> do
+      prev0' <- enter m'maps $
+        \(CacheState (retr_state, maps, mapsize, uses, incr)) ->
+          let (_, _, prev) =
+                case M.lookup id maps of
+                  Just time_prev -> time_prev
+                  Nothing -> time_prev0
+              maps' = M.delete id maps
+           in return (CacheState (retr_state, maps', mapsize, uses, incr), prev)
+      return $ Just prev0'
+    Nothing -> return Nothing
+  where
+    ECM ( m'maps, _, _, _, _, _, compactlistsize, enter, read ) = ecm
+
+
+-- | Invalidates a key from the cache and returns the last key and value if any.
+--   Note this is a sequential composition of a read and modify of the
+--   mutable cache container (readMVar and modifyMVar with newECMIO).
+--
+invalidateCache :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m (Maybe (k, v))
+invalidateCache ecm = do
+  CacheState (_, maps0, _, (uses0, _), _) <- read m'maps
+  case (M.toList $ M.intersection (M.fromList uses0) maps0) of
+    [] -> return Nothing
+    uses0' -> 
+      let (id, _) = L.maximumBy (\(_,a) (_,b) -> compare a b) uses0' in
+      case M.lookup id maps0 of
+        Just time_prev0 -> do
+          prev0' <- enter m'maps $
+            \(CacheState (retr_state, maps, _mapsize, _uses, _incr)) ->
+              let (_, _, prev) =
+                    case M.lookup id maps of
+                      Just time_prev -> time_prev
+                      Nothing -> time_prev0
+               in return (CacheState (retr_state, M.empty, 0, ([], 0), 0), prev)
+          return $ Just (id, prev0')
+  where
+    ECM ( m'maps, _, _, _, _, _, compactlistsize, enter, read ) = ecm
+
+
+-- | List of keys in the cache map, which can contain expired values, since
+--   the list is returned without performing a time check. keys are in an
+--   unspecified order.
+--
+keysCached :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m [k]
+keysCached ecm = do
+  CacheState (_, maps0, _, _, _) <- read m'maps
+  return $ M.keys maps0
+  where
+    ECM ( m'maps, _, _, _, _, _, _, _, read ) = ecm
+
+
+-- | List of keys in the cache map that are not expired values. A time check
+--   is always performed to compare the elapsed time and the cache state is not
+--   modified. The time check is not performed from within a modifying state
+--   context, e.g. not within modifyMVar with a newECMIO instance. Keys are in an
+--   unspecified order. 
+--
+keysNotExpired :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m [k]
+keysNotExpired ecm = do
+  CacheState (_, maps0, _, _, _) <- read m'maps
+  current_time <- gettime
+  return $ detNotExpired current_time $ M.toList maps0
+  where
+    ECM ( m'maps, _, gettime, _, _, _, _, _, read ) = ecm
+
 
 
 {-

@@ -1,5 +1,5 @@ name:                expiring-cache-map
-version:             0.0.5.4
+version:             0.0.6.0
 synopsis:            General purpose simple caching.
 description:         
     A simple general purpose shared state cache map with automatic expiration 
@@ -50,7 +50,9 @@       unordered-containers >= 0.2.0.0
     other-modules:
       TestHashECMWithThreads
+      TestHashECMWithThreadsInvalidating
       TestOrdECMWithThreads
+      TestOrdECMWithThreadsInvalidating
       Caching.ExpiringCacheMap.Internal.Internal
 
 test-suite test-sequence
@@ -65,5 +67,8 @@       unordered-containers >= 0.2.0.0
     other-modules:
       TestECMWithTestSequenceCommon
+      TestECMWithTestSequenceCommonInvalidating
       TestHashECMWithTestSequence
+      TestHashECMWithTestSequenceInvalidating
       TestOrdECMWithTestSequence
+      TestOrdECMWithTestSequenceInvalidating

@@ -0,0 +1,683 @@+{-# LANGUAGE OverloadedStrings #-}++module TestECMWithTestSequenceCommonInvalidating (+    someEventsOnlyI,+    numberEventsOnlyI,+    pattern'I,+    pattern''I,+    pattern'''I,+    pattern''''I,+    pattern'''''I,+    pattern''''''I,+    testLookupsI,+    printOutEventsI,+    printOutFailedPatternI+) where++import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq++import qualified Data.ByteString.Char8 as BS++printOutFailedPatternI from_where filt_events' filt_events'' filt_events''' filt_events'''' filt_events''''' filt_events'''''' = do+  putStrLn $ "Failed sequence test in " ++ from_where ++ ":"+  if not (pattern'I (filt_events'))+    then putStrLn $ "Failed: pattern 1: " ++ (show filt_events')+    else return ()+  if not (pattern''I (filt_events''))+    then putStrLn $ "Failed: pattern 2: " ++ (show filt_events'')+    else return ()+  if not (pattern'''I (filt_events'''))+    then putStrLn $ "Failed: pattern 3: " ++ (show filt_events''')+    else return ()+  if not (pattern''''I (filt_events''''))+    then putStrLn $ "Failed: pattern 4: " ++ (show filt_events'''')+    else return ()+  if not (pattern'''''I (filt_events'''''))+    then putStrLn $ "Failed: pattern 5: " ++ (show filt_events''''')+    else return ()+  if not (pattern''''''I (filt_events''''''))+    then putStrLn $ "Failed: pattern 6: " ++ (show filt_events'''''')+    else return ()+  return ()+++printOutEventsI events' events'' events''' events'''' events''''' events'''''' = do+  (putStrLn . show . filter someEventsOnlyI . reverse) events'+  (putStrLn . show . filter someEventsOnlyI . reverse) events''+  (putStrLn . show . filter someEventsOnlyI . reverse) events'''+  (putStrLn . show . filter someEventsOnlyI . reverse) events''''+  (putStrLn . show . filter someEventsOnlyI . reverse) events'''''+  (putStrLn . show . filter someEventsOnlyI . reverse) events''''''+  return ()++someEventsOnlyI a =+  case a of+    TestSeq.GetTime _    -> True+    TestSeq.ReadNumber _ -> True+    TestSeq.HaveNumber _ -> True+    _ -> False++numberEventsOnlyI a =+  case a of+    TestSeq.ReadNumber _ -> True+    TestSeq.HaveNumber _ -> True+    _ -> False++pattern'I c = +  case c of -- +    [ TestSeq.ReadNumber numr_4,  -- ReadNumber 4,GetTime 7,HaveNumber 4,HaveNumber 4+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4,+      TestSeq.HaveNumber numh_4',+      TestSeq.ReadNumber numr_21,  -- ReadNumber 21,GetTime 24,HaveNumber 21,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_21,+      TestSeq.ReadNumber numr_32,  -- ReadNumber 32,GetTime 35,HaveNumber 32,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_32,+      TestSeq.HaveNumber numh_21', -- HaveNumber 21,+      TestSeq.ReadNumber numr_50,  -- ReadNumber 50,GetTime 53,HaveNumber 50,HaveNumber 50,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_50,+      TestSeq.HaveNumber numh_50',+      +      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 2,+      +      TestSeq.ReadNumber numr_76,  -- ReadNumber 76,GetTime 79,HaveNumber 76,HaveNumber 76,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_76,+      TestSeq.HaveNumber numh_76',+      +      TestSeq.HaveNumber numh_4'',+      +      TestSeq.HaveNumber numh_76'', -- HaveNumber 76,HaveNumber 32,HaveNumber 32,+      TestSeq.HaveNumber numh_32'',+      TestSeq.HaveNumber numh_32''',+      +      TestSeq.HaveNumber 0,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_126,  -- ReadNumber 126,GetTime 129,HaveNumber 126,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_126,+      TestSeq.ReadNumber numr_137,  -- ReadNumber 137,GetTime 140,HaveNumber 137,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_137,+      TestSeq.ReadNumber numr_148,  -- ReadNumber 148,GetTime 151,HaveNumber 148,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_148,+      +      TestSeq.HaveNumber numh_126', -- HaveNumber 126,HaveNumber 137,HaveNumber 148,+      TestSeq.HaveNumber numh_137',+      TestSeq.HaveNumber numh_148',++      TestSeq.HaveNumber 3,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 3]+      |   numr_4 == numh_4 &&+          numh_4 == numh_4' &&+          numh_4 == numh_4'' &&+          numr_21 == numh_21 &&+          numh_21 == numh_21' &&+          numr_32 == numh_32 &&+          numh_32 == numh_32'' &&+          numh_32 == numh_32''' &&+          numr_50 == numh_50 &&+          numh_50 == numh_50' &&+          numr_76 == numh_76 &&+          numh_76 == numh_76' &&+          numh_76 == numh_76'' &&+          numr_126 == numh_126 &&+          numh_126 == numh_126' &&+          numr_137 == numh_137 &&+          numh_137 == numh_137' &&+          numr_148 == numh_148 &&+          numh_148 == numh_148' &&+          numh_4 < numh_21 &&+          numh_21 < numh_32 &&+          numh_32 < numh_50 &&+          numh_50 < numh_76 &&+          numh_76 < numh_126 &&+          numh_126 < numh_137 &&+          numh_137 < numh_148+            -> True+    _ -> False+    +pattern''I c = +  case c of  -- +    [ TestSeq.ReadNumber numr_4, -- ReadNumber 4,GetTime 7,HaveNumber 4,GetTime 15,GetTime 18,HaveNumber 4,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4,+      TestSeq.GetTime _,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4',+      TestSeq.ReadNumber numr_26, -- ReadNumber 26,GetTime 29,HaveNumber 26,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_26,+      TestSeq.ReadNumber numr_37, -- ReadNumber 37,GetTime 40,HaveNumber 37,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_37,+      TestSeq.HaveNumber numh_26', -- HaveNumber 26,+      TestSeq.ReadNumber numr_55, -- ReadNumber 55,GetTime 58,HaveNumber 55,HaveNumber 55,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_55,+      TestSeq.HaveNumber numh_55',+      +      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 2,+      +      TestSeq.ReadNumber numr_81,  -- ReadNumber 81,GetTime 84,HaveNumber 81,GetTime 92,GetTime 95,HaveNumber 81+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_81,+      TestSeq.GetTime _,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_81',+      +      TestSeq.GetTime _, -- GetTime 103,GetTime 106,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4'',+      +      TestSeq.GetTime _, -- GetTime 114,GetTime 117,HaveNumber 81,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_81'',+      TestSeq.GetTime _, -- GetTime 125,GetTime 128,HaveNumber 37,HaveNumber 37,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_37',+      TestSeq.HaveNumber numh_37'',+      +      TestSeq.HaveNumber 0,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_151,  -- ReadNumber 151,GetTime 154,HaveNumber 151,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_151,+      TestSeq.ReadNumber numr_162,  -- ReadNumber 162,GetTime 165,HaveNumber 162,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_162,+      TestSeq.ReadNumber numr_173,  -- ReadNumber 173,GetTime 176,HaveNumber 173,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_173,+      +      TestSeq.GetTime _, -- GetTime 184,GetTime 187,HaveNumber 151,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_151',+      TestSeq.GetTime _, -- GetTime 195,GetTime 198,HaveNumber 162,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_162',+      TestSeq.GetTime _, -- GetTime 206,GetTime 209,HaveNumber 173,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_173',++      TestSeq.HaveNumber 3,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 3]+      |   numr_4 == numh_4 &&+          numh_4 == numh_4' &&+          numh_4 == numh_4'' &&+          numr_26 == numh_26 &&+          numh_26 == numh_26' &&+          numr_37 == numh_37 &&+          numh_37 == numh_37' &&+          numh_37 == numh_37'' &&+          numr_55 == numh_55 &&+          numh_55 == numh_55' &&+          numr_81 == numh_81 &&+          numh_81 == numh_81' &&+          numh_81 == numh_81'' &&+          numr_151 == numh_151 &&+          numh_151 == numh_151' &&+          numr_162 == numh_162 &&+          numh_162 == numh_162' &&+          numr_173 == numh_173 &&+          numh_173 == numh_173' &&+          numh_4 < numh_26 &&+          numh_26 < numh_37 &&+          numh_37 < numh_55 &&+          numh_55 < numh_81 &&+          numh_81 < numh_151 &&+          numh_151 < numh_162 &&+          numh_162 < numh_173+            -> True+    _ -> False++pattern'''I c =+  case c of -- +    [ TestSeq.ReadNumber numr_4, -- ReadNumber 4,GetTime 7,HaveNumber 4,HaveNumber 4,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4,+      TestSeq.HaveNumber numh_4',+      TestSeq.ReadNumber numr_21, -- ReadNumber 21,GetTime 24,HaveNumber 21,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_21,+      TestSeq.ReadNumber numr_32, -- ReadNumber 32,GetTime 35,HaveNumber 32,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_32,+      TestSeq.HaveNumber numh_21', -- HaveNumber 21,+      TestSeq.ReadNumber numr_50, -- ReadNumber 50,GetTime 53,HaveNumber 50,HaveNumber 50,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_50,+      TestSeq.HaveNumber numh_50',+      +      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_76,  -- ReadNumber 76,GetTime 79,HaveNumber 76,HaveNumber 76,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_76,+      TestSeq.HaveNumber numh_76',+      +      TestSeq.HaveNumber numh_4'',+      +      TestSeq.HaveNumber numh_76'', -- HaveNumber 76,HaveNumber 32,HaveNumber 32,+      TestSeq.HaveNumber numh_32'',+      TestSeq.HaveNumber numh_32''',+      +      TestSeq.HaveNumber 0,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_126,  -- ReadNumber 126,GetTime 129,HaveNumber 126,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_126,+      TestSeq.ReadNumber numr_137,  -- ReadNumber 137,GetTime 140,HaveNumber 137,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_137,+      TestSeq.ReadNumber numr_148,  -- ReadNumber 148,GetTime 151,HaveNumber 148,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_148,+      +      TestSeq.HaveNumber numh_126', -- HaveNumber 126,HaveNumber 137,HaveNumber 148,+      TestSeq.HaveNumber numh_137',+      TestSeq.HaveNumber numh_148',++      TestSeq.HaveNumber 3,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0 ]+      |   numr_4 == numh_4 &&+          numh_4 == numh_4' &&+          numh_4 == numh_4'' &&+          numr_21 == numh_21 &&+          numh_21 == numh_21' &&+          numr_32 == numh_32 &&+          numh_32 == numh_32'' &&+          numh_32 == numh_32''' &&+          numr_50 == numh_50 &&+          numh_50 == numh_50' &&+          numr_76 == numh_76 &&+          numh_76' == numh_76'' &&+          numr_126 == numh_126 &&+          numh_126 == numh_126' &&+          numr_137 == numh_137 &&+          numh_137 == numh_137' &&+          numr_148 == numh_148 &&+          numh_148 == numh_148' &&+          numh_4 < numh_21 &&+          numh_21 < numh_32 &&+          numh_32 < numh_50 &&+          numh_50 < numh_76 &&+          numh_76 < numh_126 &&+          numh_126 < numh_137 &&+          numh_137 < numh_148+            -> True+    _ -> False++pattern''''I c =+  case c of -- +    [ TestSeq.ReadNumber numr_4, -- ReadNumber 4,GetTime 7,HaveNumber 4,GetTime 15,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4,+      TestSeq.GetTime _,+      TestSeq.ReadNumber numr_18, -- ReadNumber 18,GetTime 21,HaveNumber 18,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_18,+      TestSeq.ReadNumber numr_29, -- ReadNumber 29,GetTime 32,HaveNumber 29,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_29,+      TestSeq.ReadNumber numr_40, -- ReadNumber 40,GetTime 43,HaveNumber 40,HaveNumber 29,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_40,+      TestSeq.HaveNumber numh_29',+      +      TestSeq.ReadNumber numr_58, -- ReadNumber 58,GetTime 61,HaveNumber 58,HaveNumber 58,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_58,+      TestSeq.HaveNumber numh_58',+      +      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_84, -- ReadNumber 84,GetTime 87,HaveNumber 84,GetTime 95,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_84,+      TestSeq.GetTime _,+      TestSeq.ReadNumber numr_98, -- ReadNumber 98,GetTime 101,HaveNumber 98,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_98,+      TestSeq.ReadNumber numr_109, -- ReadNumber 109,GetTime 112,HaveNumber 109,GetTime 120,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_109,+      TestSeq.GetTime _,+      TestSeq.ReadNumber numr_123, -- ReadNumber 123,GetTime 126,HaveNumber 123,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_123,+      TestSeq.ReadNumber numr_134, -- ReadNumber 134,GetTime 137,HaveNumber 134,HaveNumber 134,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_134,+      TestSeq.HaveNumber numh_134',+      +      TestSeq.HaveNumber 0,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_160, -- ReadNumber 160,GetTime 163,HaveNumber 160,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_160,+      TestSeq.ReadNumber numr_171, -- ReadNumber 171,GetTime 174,HaveNumber 171,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_171,+      TestSeq.ReadNumber numr_182, -- ReadNumber 182,GetTime 185,HaveNumber 182,GetTime 193,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_182,+      TestSeq.GetTime _,+      TestSeq.ReadNumber numr_196, -- ReadNumber 196,GetTime 199,HaveNumber 196,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_196,+      TestSeq.ReadNumber numr_207, -- ReadNumber 207,GetTime 210,HaveNumber 207,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_207,+      TestSeq.ReadNumber numr_218, -- ReadNumber 218,GetTime 221,HaveNumber 218,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_218,++      TestSeq.HaveNumber 3,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0 ]+      +      |   numr_4 == numh_4 &&+          numr_18 == numh_18 &&+          numr_29 == numh_29 &&+          numh_29 == numh_29' &&+          numr_40 == numh_40 &&+          numr_58 == numh_58 &&+          numh_58 == numh_58' &&+          numr_84 == numh_84 &&+          numr_98 == numh_98 &&+          numr_109 == numh_109 &&+          numr_123 == numh_123 &&+          numr_134 == numh_134 &&+          numh_134 == numh_134' &&+          numr_160 == numh_160 &&+          numr_171 == numh_171 &&+          numr_182 == numh_182 &&+          numr_196 == numh_196 &&+          numr_207 == numh_207 &&+          numr_218 == numh_218 &&+          numr_4 < numh_18 &&+          numh_18 < numh_29 &&+          numh_29 < numh_40 &&+          numh_40 < numh_58 &&+          numh_58 < numh_84 &&+          numh_84 < numh_98 &&+          numh_98 < numh_109 &&+          numh_109 < numh_123 &&+          numh_123 < numh_134 &&+          numh_134 < numh_160 &&+          numh_160 < numh_171 &&+          numh_171 < numh_182 &&+          numh_182 < numh_196 &&+          numh_196 < numh_207 &&+          numh_207 < numh_218+            -> True+    _ -> False++pattern'''''I c =+  case c of -- +    [ TestSeq.ReadNumber numr_4, -- ReadNumber 4,GetTime 7,HaveNumber 4,HaveNumber 4,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4,+      TestSeq.HaveNumber numh_4',+      TestSeq.ReadNumber numr_21, -- ReadNumber 21,GetTime 24,HaveNumber 21,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_21,+      TestSeq.ReadNumber numr_32, -- ReadNumber 32,GetTime 35,HaveNumber 32,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_32,+      TestSeq.HaveNumber numh_21', -- HaveNumber 21,+      TestSeq.ReadNumber numr_50, -- ReadNumber 50,GetTime 53,HaveNumber 50,HaveNumber 50,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_50,+      TestSeq.HaveNumber numh_50',+      +      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 1,+      +      TestSeq.ReadNumber numr_76,  -- ReadNumber 76,GetTime 79,HaveNumber 76,HaveNumber 76,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_76,+      TestSeq.HaveNumber numh_76',+      +      TestSeq.HaveNumber numh_4'',+      +      TestSeq.HaveNumber numh_76'', -- HaveNumber 76,HaveNumber 32,HaveNumber 32,+      TestSeq.HaveNumber numh_32'',+      TestSeq.HaveNumber numh_32''',+      +      TestSeq.HaveNumber 0,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,+      +      TestSeq.ReadNumber numr_126, -- ReadNumber 126,GetTime 129,HaveNumber 126,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_126,+      TestSeq.ReadNumber numr_137, -- ReadNumber 137,GetTime 140,HaveNumber 137,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_137,+      TestSeq.ReadNumber numr_148, -- ReadNumber 148,GetTime 151,HaveNumber 148,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_148,+      +      TestSeq.HaveNumber numh_126', -- HaveNumber 126,HaveNumber 137,HaveNumber 148,+      TestSeq.HaveNumber numh_137',+      TestSeq.HaveNumber numh_148',++      TestSeq.HaveNumber 3,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 2 ]+      +      |   numr_4 == numh_4 &&+          numh_4 == numh_4' &&+          numh_4 == numh_4'' &&+          numr_21 == numh_21 &&+          numh_21 == numh_21' &&+          numr_32 == numh_32 &&+          numh_32 == numh_32'' &&+          numh_32 == numh_32''' &&+          numr_50 == numh_50 &&+          numh_50 == numh_50' &&+          numr_76 == numh_76 &&+          numh_76' == numh_76'' &&+          numr_126 == numh_126 &&+          numh_126 == numh_126' &&+          numr_137 == numh_137 &&+          numh_137 == numh_137' &&+          numr_148 == numh_148 &&+          numh_148 == numh_148' &&+          numh_4 < numh_21 &&+          numh_21 < numh_32 &&+          numh_32 < numh_50 &&+          numh_50 < numh_76 &&+          numh_76 < numh_126 &&+          numh_126 < numh_137 &&+          numh_137 < numh_148+          +            -> True+    _ -> False++pattern''''''I c =+  case c of -- +    [ TestSeq.ReadNumber numr_4, -- ReadNumber 4,GetTime 7,HaveNumber 4,GetTime 15,GetTime 18,HaveNumber 4,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4,+      TestSeq.GetTime _,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_4',+      TestSeq.ReadNumber numr_26, -- ReadNumber 26,GetTime 29,HaveNumber 26,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_26,+      TestSeq.ReadNumber numr_37, -- ReadNumber 37,GetTime 40,HaveNumber 37,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_37,+      TestSeq.HaveNumber numh_26', -- HaveNumber 26,+      TestSeq.ReadNumber numr_55, -- ReadNumber 55,GetTime 58,HaveNumber 55,HaveNumber 55,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_55,+      TestSeq.HaveNumber numh_55',+      +      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 1,+      +      TestSeq.ReadNumber numr_81, -- ReadNumber 81,GetTime 84,HaveNumber 81,GetTime 92,GetTime 95,HaveNumber 81,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_81,+      TestSeq.GetTime _,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_81',+      +      TestSeq.ReadNumber numr_103, -- ReadNumber 103,GetTime 106,HaveNumber 103,GetTime 114,GetTime 117,HaveNumber 81,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_103,+      TestSeq.GetTime _,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_81'',+      +      TestSeq.ReadNumber numr_125, -- ReadNumber 125,GetTime 128,HaveNumber 125,HaveNumber 125,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_125,+      TestSeq.HaveNumber numh_125',+      +      TestSeq.HaveNumber 0,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 0,++      TestSeq.ReadNumber numr_151, -- ReadNumber 151,GetTime 154,HaveNumber 151,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_151,+      TestSeq.ReadNumber numr_162, -- ReadNumber 162,GetTime 165,HaveNumber 162,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_162,+      TestSeq.ReadNumber numr_173, -- ReadNumber 173,GetTime 176,HaveNumber 173,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_173,++      TestSeq.GetTime _, -- GetTime 184,GetTime 187,HaveNumber 151,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_151',+      TestSeq.GetTime _, -- GetTime 195,GetTime 198,HaveNumber 162,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_162',+      TestSeq.GetTime _, -- GetTime 206,GetTime 209,HaveNumber 173,+      TestSeq.GetTime _,+      TestSeq.HaveNumber numh_173',++      TestSeq.HaveNumber 2,+      TestSeq.GetTime _,+      TestSeq.HaveNumber 1 ]+      |   numr_4 == numh_4 &&+          numh_4 == numh_4' &&+          numr_26 == numh_26 &&+          numh_26 == numh_26' &&+          numr_37 == numh_37 &&+          numr_55 == numh_55 &&+          numh_55 == numh_55' &&+          numr_81 == numh_81 &&+          numh_81 == numh_81' &&+          numh_81 == numh_81'' &&+          numr_103 == numh_103 &&+          numr_125 == numh_125 &&+          numh_125 == numh_125' &&+          numr_151 == numh_151 &&+          numh_151 == numh_151' &&+          numr_162 == numh_162 &&+          numh_162 == numh_162' &&+          numr_173 == numh_173 &&+          numh_173 == numh_173' &&+          numh_4 < numh_26 &&+          numh_26 < numh_37 &&+          numh_37 < numh_55 &&+          numh_55 < numh_81 &&+          numh_81 < numh_103 &&+          numh_103 < numh_125 &&+          numh_125 < numh_151 &&+          numh_151 < numh_162 &&+          numh_162 < numh_173+            -> True+    _ -> False++testLookupsI lookup invalidate invalidateCache keysCached keysNotExpired = do+  b <- lookup ("file1" :: BS.ByteString)+  TestSeq.haveNumber b+  b <- lookup "file1"+  TestSeq.haveNumber b+  b <- lookup "file2"+  TestSeq.haveNumber b+  b <- lookup "file3"+  TestSeq.haveNumber b+  mb <- invalidate "file2"+  case mb of+    Just b  -> TestSeq.haveNumber b+    Nothing -> TestSeq.haveNumber 0+  b <- lookup "file2"+  TestSeq.haveNumber b+  mb <- invalidate "file2"+  case mb of+    Just b  -> TestSeq.haveNumber b+    Nothing -> TestSeq.haveNumber 0+  l <- keysCached+  TestSeq.haveNumber (length l)+  l <- keysNotExpired+  TestSeq.haveNumber (length l)+  b <- lookup "file2"+  TestSeq.haveNumber b+  b <- lookup "file2"+  TestSeq.haveNumber b+  b <- lookup "file1"+  TestSeq.haveNumber b+  b <- lookup "file2"+  TestSeq.haveNumber b+  b <- lookup "file3"+  TestSeq.haveNumber b+  mk <- invalidateCache+  case mk of+    Just (_, b) -> TestSeq.haveNumber b+    Nothing     -> TestSeq.haveNumber 0+  l <- keysCached+  TestSeq.haveNumber (length l)+  l <- keysNotExpired+  TestSeq.haveNumber (length l)+  b <- lookup "file1"+  TestSeq.haveNumber b+  b <- lookup "file2"+  TestSeq.haveNumber b+  b <- lookup "file3"+  TestSeq.haveNumber b+  b <- lookup "file1"+  TestSeq.haveNumber b+  b <- lookup "file2"+  TestSeq.haveNumber b+  b <- lookup "file3"+  TestSeq.haveNumber b+  l <- keysCached+  TestSeq.haveNumber (length l)+  l <- keysNotExpired+  TestSeq.haveNumber (length l)+  +  return b

@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}++module TestHashECMWithTestSequenceInvalidating (+    testWithTestSequenceInvalidating+) where++import Caching.ExpiringCacheMap.HashECM (newECMForM, lookupECM, CacheSettings(..), consistentDuration, invalidate, invalidateCache, keysCached, keysNotExpired)+import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq++import TestECMWithTestSequenceCommonInvalidating++import qualified Data.ByteString.Char8 as BS+import System.Exit (exitFailure)++testWithTestSequenceInvalidating = do+  (TestSeq.TestSequenceState (_, events',    _), return_value) <- TestSeq.runTestSequence test'+  (TestSeq.TestSequenceState (_, events'',   _), return_value) <- TestSeq.runTestSequence test''+  (TestSeq.TestSequenceState (_, events''',  _), return_value) <- TestSeq.runTestSequence test'''+  (TestSeq.TestSequenceState (_, events'''', _), return_value) <- TestSeq.runTestSequence test''''+  (TestSeq.TestSequenceState (_, events''''',  _), return_value) <- TestSeq.runTestSequence test'''''+  (TestSeq.TestSequenceState (_, events'''''', _), return_value) <- TestSeq.runTestSequence test''''''+  if pattern'I    (filt events') &&+     pattern''I   (filt events'') &&+     pattern'''I  (filt events''') &&+     pattern''''I (filt events'''') &&+     pattern'''''I  (filt events''''') &&+     pattern''''''I (filt events'''''')+    then do+      putStrLn "Passed TestHashECMWithTestSequenceInvalidating"+      -- printOutEvents events' events'' events''' events''''+      return ()+    else do+      printOutFailedPatternI "TestHashECMWithTestSequenceInvalidating.testWithTestSequenceInvalidating"+        (filt events') (filt events'') (filt events''') (filt events'''') (filt events''''') (filt events'''''')+      printOutEventsI events' events'' events''' events'''' events''''' events''''''+      exitFailure+  where+    filt = filter someEventsOnlyI . reverse+    commonreadnumber =+      (\state _id -> do number <- TestSeq.readNumber+                        return (state, number))+    +    newTestECM valreq timecheck =+      newECMForM valreq+        (TestSeq.getCurrentTime >>= return)+        timecheck+        (CacheWithLRUList 6 6 12)+        TestSeq.newTestSVar TestSeq.enterTestSVar TestSeq.readTestSVar+            +    test' = do+      filecache <- newTestECM+        (consistentDuration 100 commonreadnumber) -- Duration between access and expiry time+        12000 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test'' = do+      filecache <- newTestECM+        (consistentDuration 100 commonreadnumber) -- Duration between access and expiry time+        1 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test''' = do+      filecache <- newTestECM+        (consistentDuration 1 commonreadnumber) -- Duration between access and expiry time+        12000 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test'''' = do+      filecache <- newTestECM+        (consistentDuration 1 commonreadnumber) -- Duration between access and expiry time+        1 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test''''' = do+      filecache <- newTestECM+        (consistentDuration 50 commonreadnumber) -- Duration between access and expiry time+        12000 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test'''''' = do+      filecache <- newTestECM+        (consistentDuration 50 commonreadnumber) -- Duration between access and expiry time+        1 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+

@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}++--+-- Test HashECM with threads+--++module TestHashECMWithThreadsInvalidating (+    testWithThreadsInvalidating+) where++import Control.Concurrent (forkIO, threadDelay, yield)+import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)+import qualified Data.ByteString.Lazy.Char8 as LBS++import qualified Control.Concurrent.MVar as MV+import qualified Data.HashMap.Strict as HM+import Data.Hashable (Hashable(..))++import Caching.ExpiringCacheMap.HashECM+import Caching.ExpiringCacheMap.Internal.Internal (getStatsString)++import System.Timeout (timeout)+import System.Exit (exitFailure)++testWithThreadsInvalidating = do+  res <- timeout 60000000 testWithThreadsInvalidating'+  case res of+    Nothing -> exitFailure+    Just () -> return ()++testWithThreadsInvalidating' = do+  ecm <- newECMIO+            (consistentDuration 10+              (\state id -> do LBS.putStrLn id; return (state, [])))+            (do time <- POSIX.getPOSIXTime+                return (round (time * 100)))+            120 +            (CacheWithLRUList 6 6 12) :: IO (ECM IO MV.MVar () HM.HashMap LBS.ByteString [Int])+  t1 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.2"+      yield+      return ())+      [0..500]+    MV.putMVar t1 True+  t2 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.3"+      yield+      return ())+      [0..333]+    MV.putMVar t2 True+  t3 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.2"+      yield+      return ())+      [0..200]+    MV.putMVar t3 True+  t4 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.7"+      yield+      return ())+      [0..142]+    MV.putMVar t4 True+  t5 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.3"+      yield+      return ())+      [0..90]+    MV.putMVar t5 True+  t6 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.13"+      yield+      return ())+      [0..76]+    MV.putMVar t6 True+  t7 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.7"+      yield+      return ())+      [0..58]+    MV.putMVar t7 True+  t8 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.19"+      yield+      return ())+      [0..52]+    MV.putMVar t8 True+  t9 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.13"+      yield+      return ())+      [0..43]+    MV.putMVar t9 True+  untilDone [t1,t2,t3,t4,t5,t6,t7,t8,t9]+  c <- getStatsString ecm+  putStrLn c+  return ()+  where+    untilDone [] = return ()+    untilDone (t:tr) = MV.takeMVar t >> untilDone tr+      

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}++module TestOrdECMWithTestSequenceInvalidating (+    testWithTestSequenceInvalidating+) where++import Caching.ExpiringCacheMap.OrdECM (newECMForM, lookupECM, CacheSettings(..), consistentDuration, invalidate, invalidateCache, keysCached, keysNotExpired)+import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq++import TestECMWithTestSequenceCommonInvalidating++import qualified Data.ByteString.Char8 as BS+import System.Exit (exitFailure)++testWithTestSequenceInvalidating = do+  (TestSeq.TestSequenceState (_, events',    _), return_value) <- TestSeq.runTestSequence test'+  (TestSeq.TestSequenceState (_, events'',   _), return_value) <- TestSeq.runTestSequence test''+  (TestSeq.TestSequenceState (_, events''',  _), return_value) <- TestSeq.runTestSequence test'''+  (TestSeq.TestSequenceState (_, events'''', _), return_value) <- TestSeq.runTestSequence test''''+  (TestSeq.TestSequenceState (_, events''''',  _), return_value) <- TestSeq.runTestSequence test'''''+  (TestSeq.TestSequenceState (_, events'''''', _), return_value) <- TestSeq.runTestSequence test''''''+  if pattern'I    (filt events') &&+     pattern''I   (filt events'') &&+     pattern'''I  (filt events''') &&+     pattern''''I (filt events'''') &&+     pattern'''''I  (filt events''''') &&+     pattern''''''I (filt events'''''')+    then do+      putStrLn "Passed TestOrdECMWithTestSequenceInvalidating"+      -- printOutEvents events' events'' events''' events''''+      return ()+    else do+      printOutFailedPatternI "TestOrdECMWithTestSequenceInvalidating.testWithTestSequenceInvalidating"+        (filt events') (filt events'') (filt events''') (filt events'''') (filt events''''') (filt events'''''')+      printOutEventsI events' events'' events''' events'''' events''''' events''''''+      exitFailure+  where+    filt = filter someEventsOnlyI . reverse+    commonreadnumber = +      (\state _id -> do number <- TestSeq.readNumber+                        return (state, number))+    +    newTestECM valreq timecheck =+      newECMForM valreq+        (TestSeq.getCurrentTime >>= return)+        timecheck+        (CacheWithLRUList 6 6 12)+        TestSeq.newTestSVar TestSeq.enterTestSVar TestSeq.readTestSVar+  +    test' = do+      filecache <- newTestECM+        (consistentDuration 100 commonreadnumber) -- Duration between access and expiry time+        12000 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test'' = do+      filecache <- newTestECM+        (consistentDuration 100 commonreadnumber) -- Duration between access and expiry time+        1 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+  +    test''' = do+      filecache <- newTestECM+        (consistentDuration 1 commonreadnumber) -- Duration between access and expiry time+        12000 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test'''' = do+      filecache <- newTestECM+        (consistentDuration 1 commonreadnumber) -- Duration between access and expiry time+        1 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)++    test''''' = do+      filecache <- newTestECM+        (consistentDuration 50 commonreadnumber) -- Duration between access and expiry time+        12000 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)+    +    test'''''' = do+      filecache <- newTestECM+        (consistentDuration 50 commonreadnumber) -- Duration between access and expiry time+        1 -- Time check frequency+      testLookupsI (lookupECM filecache) (invalidate filecache) (invalidateCache filecache) (keysCached filecache) (keysNotExpired filecache)

@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}++--+-- Test OrdECM with threads+--++module TestOrdECMWithThreadsInvalidating (+    testWithThreadsInvalidating+) where++import Control.Concurrent (forkIO, threadDelay, yield)+import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)+import qualified Data.ByteString.Lazy.Char8 as LBS++import qualified Control.Concurrent.MVar as MV+import qualified Data.Map as M++import Caching.ExpiringCacheMap.OrdECM+import Caching.ExpiringCacheMap.Internal.Internal (getStatsString)++import System.Timeout (timeout)+import System.Exit (exitFailure)++testWithThreadsInvalidating = do+  res <- timeout 60000000 testWithThreadsInvalidating'+  case res of+    Nothing -> exitFailure+    Just () -> return ()++testWithThreadsInvalidating' = do+  ecm <- newECMIO+            (consistentDuration 10+              (\state id -> do LBS.putStrLn id; return (state, [])))+            (do time <- POSIX.getPOSIXTime+                return (round (time * 100)))+            120+            (CacheWithLRUList 6 6 12 ) :: IO (ECM IO MV.MVar () M.Map LBS.ByteString [Int])+  t1 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.2"+      yield+      return ())+      [0..500]+    MV.putMVar t1 True+  t2 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.3"+      yield+      return ())+      [0..333]+    MV.putMVar t2 True+  t3 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.2"+      yield+      return ())+      [0..200]+    MV.putMVar t3 True+  t4 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.7"+      yield+      return ())+      [0..142]+    MV.putMVar t4 True+  t5 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.3"+      yield+      return ())+      [0..90]+    MV.putMVar t5 True+  t6 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.13"+      yield+      return ())+      [0..76]+    MV.putMVar t6 True+  t7 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.7"+      yield+      return ())+      [0..58]+    MV.putMVar t7 True+  t8 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- lookupECM ecm "test.19"+      yield+      return ())+      [0..52]+    MV.putMVar t8 True+  t9 <- MV.newEmptyMVar+  forkIO $ do+    mapM_ (\a -> do+      b <- invalidate ecm "test.13"+      yield+      return ())+      [0..43]+    MV.putMVar t9 True+  untilDone [t1,t2,t3,t4,t5,t6,t7,t8,t9]+  c <- getStatsString ecm+  putStrLn c+  return ()+  where+    untilDone [] = return ()+    untilDone (t:tr) = MV.takeMVar t >> untilDone tr

@@ -1,9 +1,12 @@--- module TestWithTestSequence where
 
 import qualified TestOrdECMWithTestSequence as OrdTest
 import qualified TestHashECMWithTestSequence as HashTest
+import qualified TestOrdECMWithTestSequenceInvalidating as OrdTestInvalidating
+import qualified TestHashECMWithTestSequenceInvalidating as HashTestInvalidating
 
 main = do
   HashTest.testWithTestSequence
   OrdTest.testWithTestSequence
-  return ()+  HashTestInvalidating.testWithTestSequenceInvalidating
+  OrdTestInvalidating.testWithTestSequenceInvalidating
+  return ()

@@ -1,17 +1,17 @@-{-# LANGUAGE OverloadedStrings #-}
-
 --
 -- Test with threads
 --
 
--- module TestWithThreads where
-
 import qualified TestOrdECMWithThreads as OrdTest
 import qualified TestHashECMWithThreads as HashTest
+import qualified TestOrdECMWithThreadsInvalidating as OrdTestInvalidating
+import qualified TestHashECMWithThreadsInvalidating as HashTestInvalidating
 
 testWithThreads = do
   HashTest.testWithThreads
   OrdTest.testWithThreads
+  HashTestInvalidating.testWithThreadsInvalidating
+  OrdTestInvalidating.testWithThreadsInvalidating
   return ()
 
 main = testWithThreads