Split the Map tests apart to share common tests for SLMap and PureMap

Interestingly, the excessive duplication is only on the SLMap
version (see issue #28).

haskell/lvish/Data/LVar/SLMap.hs

@@ -31,12 +31,12 @@ module Data.LVar.SLMap
          IMap,
          newEmptyMap, newMap, newFromList,
          insert, 
-         getKey, waitSize, modify,
+         getKey, waitSize, waitValue,
+         modify,
 
          -- * Quasi-deterministic operations
          freezeMap,
-         traverseFrzn_,
-         -- waitValue, 
+         traverseFrzn_,         
 
          -- * Iteration and callbacks
          forEach, forEachHP, 
@@ -256,7 +256,18 @@ getKey !key (IMap (WrapLVar lv)) = WrapPar$ getLV lv globalThresh deltaThresh
 
 -- | Wait until the map contains a certain value (on any key).
 waitValue :: (Ord k, Eq v) => v -> IMap k s v -> Par d s ()
-waitValue !val (IMap (WrapLVar lv)) = error "TODO / FINISHME SLMap.waitValue"
+waitValue !val (IMap (WrapLVar lv)) = WrapPar$ getLV lv globalThresh deltaThresh
+  where
+    deltaThresh (_,v) | v == val  = return$ Just ()
+                      | otherwise = return Nothing
+    globalThresh ref _frzn = do
+      let slm = L.state lv
+      let fn Nothing _k v | v == val  = return $! Just ()
+                          | otherwise = return $ Nothing
+          fn just _ _  = return $! just
+      -- This is inefficient.
+      -- FIXME: no short-circuit for this fold:
+      SLM.foldlWithKey id fn Nothing slm
 
 -- | Wait on the SIZE of the map, not its contents.
 waitSize :: Int -> IMap k s v -> Par d s ()

haskell/lvish/tests/CommonMapTests.hs

@@ -0,0 +1,130 @@
+
+-- This is NOT a full Haskell module.
+-- This is a slice of source code that is #included into multiple files.
+
+import Test.Framework.Providers.HUnit 
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.HUnit (Assertion, assertEqual, assertBool, Counts(..))
+import Test.Framework.TH (testGroupGenerator)
+import qualified Test.HUnit as HU
+import TestHelpers as T
+import Control.Concurrent (threadDelay)
+import Data.Traversable (traverse)
+import qualified Data.Foldable as F
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.List as L
+import Data.IORef
+import System.Random
+
+import           Control.LVish
+import           Control.LVish.DeepFrz (DeepFrz(..), Frzn, Trvrsbl, runParThenFreeze, runParThenFreezeIO)
+import qualified Control.LVish.Internal as I
+import qualified Data.LVar.IVar as IV
+--------------------------------------------------------------------------------
+
+
+case_v7a :: Assertion
+case_v7a = assertEqual "basic imap test"
+--           (M.fromList [(1,1.0),(2,2.0),(3,3.0),(100,100.1),(200,201.1)]) =<<
+--           [(1,1.0),(2,2.0),(3,3.0),(100,100.1),(200,201.1)] =<<
+           [1.0,2.0,3.0,100.1,201.1] =<<
+           v7a
+
+-- v7a :: IO ([(Int,Float)])
+v7a :: IO [Float]
+v7a = fmap (L.sort . F.toList) $
+  runParIO $ IM.freezeMap =<<
+  do mp <- IM.newEmptyMap
+     fork $ do IM.waitSize 3 mp
+               IM.insert 100 100.1 mp
+     fork $ do IM.waitValue 100.1 mp
+               v <- IM.getKey 1 mp
+               IM.insert 200 (200.1 + v) mp
+     IM.insert 1 1 mp
+     IM.insert 2 2 mp
+     logDbgLn 1 "[v7a] Did the first two puts.."
+     I.liftIO$ threadDelay 1000
+     IM.insert 3 3 mp
+     logDbgLn 1 "[v7a] Did the first third put."
+     IM.waitSize 5 mp
+     return mp
+
+
+--------------------------------------------------------------------------------
+-- Issue related:
+--------------------------------------------------------------------------------
+
+-- Issue #27, spurious duplication.
+case_handlrDup :: Assertion
+case_handlrDup = runParIO $ do
+  ctr <- I.liftIO$ newIORef 0
+  mp  <- IM.newEmptyMap
+  hp  <- newPool
+  -- Register handler FIRST.. no race.
+  IM.forEachHP (Just hp) mp $ \ (k::Int) v -> do
+    logDbgLn 1 $ "[case_handlrDup] Callback executing: " ++ show (k,v)
+    I.liftIO $ incr ctr
+  IM.insert 2 2 mp
+  IM.insert 3 3 mp 
+  quiesce hp
+  sum <- I.liftIO $ readIORef ctr
+  I.liftIO $ assertEqual "Should be no duplication in this case" 2 sum
+
+incr :: IORef Int -> IO ()
+incr ref = atomicModifyIORef' ref (\x -> (x+1,()))
+
+--------------------------------------------------------------------------------
+-- Parallel insertion
+--------------------------------------------------------------------------------
+
+-- -- | Perform a fork-join computation and populate a SkipListMap in parallel.
+-- fillOne :: [(Int, Int)] -> IO (SLM.SLMap Int Int)
+-- fillOne chunks = do
+--   slm <- SLM.newSLMap 10
+--   mvars <- forM chunks $ \ (start,end) -> do
+--     mv <- newEmptyMVar
+--     forkWithExceptions forkIO "slm2 test thread" $ do
+--       rgen <- newIORef $ mkStdGen 0
+--       let flip = do
+--             g <- readIORef rgen
+--             let (b, g') = random g
+--             writeIORef rgen $! g'
+--             return b
+--       T.for_ (start, end)$ \n -> void (SLM.putIfAbsentToss slm n (return n) flip)
+--       putMVar mv ()
+--     return mv  
+--   forM_ mvars takeMVar  
+--   return slm
+
+-- insertionTest :: [(Int, Int)] -> IO (Bool, Word64)
+-- insertionTest chunks = do
+--   slm <- timeit$ fillOne chunks 
+--   -- End timing.  Timing just the insertion phase.
+--   cs <- SLM.counts slm
+--   logDbgLn_ 1 $ "After insertions, counts: " ++ show cs
+--   sliceCheck slm    
+--   matches <- SLM.foldlWithKey id (\b k v -> if k == v then return b else return False) True slm
+--   summed  <- SLM.foldlWithKey id (\s _ v -> return $! s + fromIntegral v) 0 slm
+--   printLog
+--   return (matches, summed)
+
+
+
+--------------------------------------------------------------------------------
+-- Parallel folding  
+--------------------------------------------------------------------------------
+
+-- case_parfoldslm1 :: Assertion 
+-- case_parfoldslm1 =
+--   assertEqual "test concurrent insertion for SkipListMap (#4)" expectedSum =<<
+--     (do slm <- fillOne (splitRange numCapabilities (1,mediumSize))
+--         return expectedSum
+--     )
+
+
+
+--------------------------------------------------------------------------------
+
+tests_common :: Test
+tests_common = testGroup "Common" [ $(testGroupGenerator) ] 

haskell/lvish/tests/Makefile

@@ -9,7 +9,7 @@ LIBSRC =
 ARGS = -DGENERIC_PAR -threaded -DDEBUG_LVAR $(GHC_ARGS)
 # -fforce-recomp
 
-ALLEXES = ArrayTests.exe GenericTests.exe LVishAndIVar.exe LogicalTests.exe MapTests.exe MaxCounterTests.exe MemoTests.exe SNZITests.exe SetTests.exe SkipListTests.exe Main.exe 
+ALLEXES = ArrayTests.exe GenericTests.exe LVishAndIVar.exe LogicalTests.exe PureMapTests.exe SLMapTests.exe MaxCounterTests.exe MemoTests.exe SNZITests.exe SetTests.exe SkipListTests.exe Main.exe 
 
  .SUFFIXES: .hs .exe
 
@@ -20,7 +20,7 @@ prof:
 	rm -f MapTests.exe
 	GHC_ARGS="-prof -auto-all -osuf=po" $(MAKE) MapTests.exe
 
-.hs.exe:
+.hs.exe: CommonMapTests.hs
 	ghc $(ARGS) -i.. -main-is $(^:.hs=.runTests) $^ -o $@
 
 main: Main.exe

haskell/lvish/tests/MapTests.hs → haskell/lvish/tests/PureMapTests.hs

@@ -1,65 +1,29 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 
 -- | Tests for the Data.LVar.PureMap and Data.LVar.SLMap modules.
 
-module MapTests(tests, runTests) where
-
-import Test.Framework.Providers.HUnit 
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.HUnit (Assertion, assertEqual, assertBool, Counts(..))
-import Test.Framework.TH (testGroupGenerator)
-import qualified Test.HUnit as HU
-import TestHelpers as T
-
-import Control.Concurrent (threadDelay)
-import Data.Traversable (traverse)
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Data.IORef
-import System.Random
+module PureMapTests(tests, runTests) where
 
 import Data.LVar.PureSet as IS
 import Data.LVar.PureMap as IM
-import qualified Data.LVar.SLMap as SM
-import qualified Data.LVar.IVar as IV
 
-import           Control.LVish
-import           Control.LVish.DeepFrz (DeepFrz(..), Frzn, Trvrsbl, runParThenFreeze, runParThenFreezeIO)
-import qualified Control.LVish.Internal as I
+#include "CommonMapTests.hs"
 
 --------------------------------------------------------------------------------
 
 tests :: Test
-tests = $(testGroupGenerator)
+tests = testGroup "" [tests_here, tests_common ]
+
+tests_here :: Test
+tests_here = $(testGroupGenerator)
 
 runTests :: IO ()
 runTests = defaultMain [tests]
 
 --------------------------------------------------------------------------------
 
-case_v7a :: Assertion
-case_v7a = assertEqual "basic imap test"
-           (M.fromList [(1,1.0),(2,2.0),(3,3.0),(100,100.1),(200,201.1)]) =<<
-           v7a
-
-v7a :: IO (M.Map Int Float)
-v7a = runParIO $ IM.freezeMap =<<
-  do mp <- IM.newEmptyMap
-     fork $ do IM.waitSize 3 mp
-               IM.insert 100 100.1 mp
-     fork $ do IM.waitValue 100.1 mp
-               v <- IM.getKey 1 mp
-               IM.insert 200 (200.1 + v) mp
-     IM.insert 1 1 mp
-     IM.insert 2 2 mp
-     logDbgLn 1 "[v7a] Did the first two puts.."
-     I.liftIO$ threadDelay 1000
-     IM.insert 3 3 mp
-     logDbgLn 1 "[v7a] Did the first third put."
-     IM.waitSize 5 mp
-     return mp
-
 -- [2013.08.05] RRN: Observing nondeterministic blocked-indefinitely
 -- exception here.
 case_i7b :: Assertion
@@ -73,7 +37,7 @@ case_i7b = do
 
 -- | A quasi-deterministic example.
 i7b :: IO (M.Map Int (S.Set Float))
--- Do we need a "deep freeze" that freezes nested structures?
+-- A manual nested freeze instead of DeepFrz:
 i7b = runParIO $ do
   mp <- IM.newEmptyMap
   s1 <- IS.newEmptySet
@@ -90,13 +54,6 @@ i7b = runParIO $ do
   mp2 <- IM.freezeMap mp
   traverse IS.freezeSet mp2
 
-case_v7c :: Assertion
-case_v7c = assertEqual "imap test - racing modifies"
-           (M.fromList [(1,S.fromList [3.33]),
-                        (2,S.fromList [4.44]),
-                        (3,S.fromList [5.55,6.6])]) =<<
-           v7c
-
 -- | This example is valid because two modifies may race.
 v7c :: IO (M.Map Int (S.Set Float))
 -- Do we need a "deep freeze" that freezes nested structures?
@@ -117,6 +74,13 @@ v7c = runParIO $ do
   mp2 <- IM.freezeMap mp
   traverse IS.freezeSet mp2
 
+case_v7c :: Assertion
+case_v7c = assertEqual "imap test - racing modifies"
+           (M.fromList [(1,S.fromList [3.33]),
+                        (2,S.fromList [4.44]),
+                        (3,S.fromList [5.55,6.6])]) =<<
+           v7c
+
 --------------------------------------------------------------------------------
 -- Tests that use `forEachHP`
 --------------------------------------------------------------------------------  
@@ -167,16 +131,6 @@ v8d = runParIO $ do
 -- Show instances
 ------------------------------------------------------------------------------------------
 
--- | It happens that these come out in the opposite order from the Pure one:
-case_show02 :: Assertion
-case_show02 = assertEqual "show for SLMap" "{IMap: (\"key2\",44), (\"key1\",33)}" show02
-show02 :: String
-show02 = show$ runParThenFreeze $ do
-  mp <- SM.newEmptyMap
-  SM.insert "key1" (33::Int) mp
-  SM.insert "key2" (44::Int) mp  
-  return mp
-
 case_show03 :: Assertion
 case_show03 = assertEqual "show for PureMap" "{IMap: (\"key1\",33), (\"key2\",44)}" show03
 show03 :: String
@@ -187,25 +141,3 @@ show03 = show$ runParThenFreeze $ do
   return mp
 
 
---------------------------------------------------------------------------------
--- Issue related:
---------------------------------------------------------------------------------
-
--- Issue #27, spurious duplication.
-case_handlrDup :: Assertion
-case_handlrDup = runParIO $ do
-  ctr <- I.liftIO$ newIORef 0
-  mp  <- SM.newEmptyMap
-  hp  <- newPool
-  -- Register handler FIRST.. no race.
-  SM.forEachHP (Just hp) mp $ \ (k::Int) v -> do
-    logDbgLn 1 $ "[case_handlrDup] Callback executing: " ++ show (k,v)
-    I.liftIO $ incr ctr
-  SM.insert 2 2 mp
-  SM.insert 3 3 mp 
-  quiesce hp
-  sum <- I.liftIO $ readIORef ctr
-  I.liftIO $ assertEqual "Should be no duplication in this case" 2 sum
-
-incr :: IORef Int -> IO ()
-incr ref = atomicModifyIORef' ref (\x -> (x+1,()))