diff options
Diffstat (limited to 'testsuite/tests/concurrent/prog003/TestRun.hs')
| -rw-r--r-- | testsuite/tests/concurrent/prog003/TestRun.hs | 219 |
1 files changed, 219 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/prog003/TestRun.hs b/testsuite/tests/concurrent/prog003/TestRun.hs new file mode 100644 index 0000000000..fd6e19de1d --- /dev/null +++ b/testsuite/tests/concurrent/prog003/TestRun.hs @@ -0,0 +1,219 @@ + +{-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses #-} + +module TestRun ( + run_testdata -- FilePath -> FilePath -> IO () +) where + +import TestData +import TestDataParser +import Collection + +import Control.Monad +import GHC.Conc +import Text.Printf +import Data.List +import Data.IORef +import Control.Concurrent +--import Control.Concurrent.STM +import System.Environment +import Data.Time +import System.Mem +import System.Random +import Control.Exception + +-- the contenders +import qualified CASList as CAS +import qualified ImmList as IMM +--import qualified CASusingSTMList as CASusingSTM +import qualified MVarListLockCoupling as MLC +--import qualified MVarusingSTM as MLCusingSTM +--import qualified LazyList2 as Lazy +import qualified IOList as I +--import qualified STMList as S + + + +instance (Eq e, Show e) => Col (CAS.ListHandle e) e where + newCol = CAS.newList + insertCol c e = do CAS.addToTail c e + return () + deleteCol = CAS.delete + findCol = CAS.find + printCol = CAS.printList + cntCol = CAS.cntList + +instance (Eq e, Show e) => Col (IMM.ListHandle e) e where + newCol = IMM.newList + insertCol c e = do IMM.addToTail c e + return () + deleteCol = IMM.delete + findCol = IMM.find + printCol = IMM.printList + cntCol = IMM.cntList + +--instance (Eq e, Show e) => Col (CASusingSTM.ListHandle e) e where +-- newCol = CASusingSTM.newList +-- insertCol c e = do CASusingSTM.addToTail c e +-- return () +-- deleteCol = CASusingSTM.delete +-- findCol = CASusingSTM.find +-- printCol = CASusingSTM.printList +-- cntCol = CASusingSTM.cntList + + +--instance (Eq e, Show e) => Col (Lazy.ListHandle e) e where +-- newCol = Lazy.newList +-- insertCol c e = do Lazy.addToTail c e +-- return () +-- deleteCol = Lazy.delete +-- findCol = Lazy.find +-- printCol = Lazy.printList +-- cntCol = Lazy.cntList + + +instance (Eq e, Show e) => Col (I.ListHandle e) e where + newCol = I.newList + insertCol c e = do I.addToTail c e + return () + deleteCol = I.delete + findCol = I.find + printCol = I.printList + cntCol = I.cntList + +--instance (Eq e, Show e) => Col (MLCusingSTM.ListHandle e) e where +-- newCol = MLCusingSTM.newList +-- insertCol c e = do MLCusingSTM.addToTail c e +-- return () +-- deleteCol = MLCusingSTM.delete +-- findCol = MLCusingSTM.find +-- printCol = MLCusingSTM.printList +-- cntCol = MLCusingSTM.cntList + + +instance (Eq e, Show e) => Col (MLC.ListHandle e) e where + newCol = MLC.newList + insertCol c e = do MLC.addToTail c e + return () + deleteCol = MLC.delete + findCol = MLC.find + printCol = MLC.printList + cntCol = MLC.cntList + +--instance (Eq e, Show e) => Col (S.ListHandle e) e where +-- newCol = S.newList +-- insertCol c e = do S.addToTail c e +-- return () +-- deleteCol = S.delete +-- findCol = S.find +-- printCol = S.printList +-- cntCol = S.cntList + +-- Auxiliary functions + +createList :: Col c e => [e] -> IO c +createList n = + do nl <- newCol + mapM (insertCol nl) n + return nl + +executeTasks :: Col c e => c -> [Op e] -> IO () +executeTasks lh ops = + do mapM (\ task -> + case task of + Find x -> do { findCol lh x; return () } + Insert x -> do { insertCol lh x; return () } + Delete x -> do { deleteCol lh x; return () }) + ops + return () + +appendIORef :: IORef [a] -> a -> IO () +appendIORef ref a = do + { as <- readIORef ref + ; writeIORef ref (a:as) } + +showComma :: [String] -> String +showComma (s:ss) = "," ++ s ++ (showComma ss) +showComma [] = "" + +-- Main interface + +run_testdata :: FilePath -> String -> IO () +run_testdata testdata_fname mode = do + { tc <- parse_testdata testdata_fname + ; putStrLn "Test Initiated: " + ; let init_elems = t_init_list tc + works = t_tasks tc + ; medians <- newIORef [] + ; highlows <- newIORef [] + ; runtests mode init_elems works (medians,highlows) + } + where + runtests m elems works refs = + case m of + "CAS" -> do nl :: CAS.ListHandle Int <- createList elems + runtest m works nl refs + "IMM" -> do nl :: IMM.ListHandle Int <- createList elems + runtest m works nl refs +-- "CASusingSTM" -> do nl :: CASusingSTM.ListHandle Int <- createList elems +-- runtest m works nl refs +-- "LAZY" -> do nl :: Lazy.ListHandle Int <- createList elems +-- runtest m works nl refs + "MLC" -> do nl :: MLC.ListHandle Int <- createList elems + runtest m works nl refs +-- "MLCusingSTM" -> do nl :: MLCusingSTM.ListHandle Int <- createList elems +-- runtest m works nl refs + "IO" -> do nl :: I.ListHandle Int <- createList elems + runtest m works nl refs +-- "STM" -> do nl :: S.ListHandle Int <- createList elems +-- runtest m works nl refs + trash -> fail $ "Oi! No such concurrency mode: " ++ trash + + + runtest m works nl (medians,highlows) = do + { putStrLn $ "Test Started: " ++ m + ; performGC +-- ; wait <- atomically (newTVar 0) + ; wait <- newEmptyMVar + ; start <- getCurrentTime + ; zipWithM (\n work -> forkOnIO n (do { executeTasks nl work + ; putMVar wait () })) + --atomically(do counter <- readTVar wait +-- writeTVar wait (counter+1)) })) + [0..] works + ; replicateM_ (length works) (takeMVar wait) +-- ; atomically ( do { counter <- readTVar wait +-- ; if counter < length works then retry +-- else return () } ) + ; fin <- getCurrentTime + ; let result = diffUTCTime fin start + ; -- printf "time: %.2fs\n" (realToFrac result :: Double) + ; return () } + + output_fname = "out" + + write_output mod ms mref hlref = do + { if mod == 1 + then do { writeFile output_fname "" + ; output_header output_fname ms + ; appendFile output_fname ",," + ; output_header output_fname ms + ; appendFile output_fname "\n1Core" } + else appendFile output_fname ("\n" ++ (show mod) ++ "Cores") + ; medians <- readIORef mref + ; highlows <- readIORef hlref + ; let mstr = reverse $ map show medians + hlstr = reverse $ highlows + ; appendFile output_fname (filter (/='s') (showComma mstr)) + ; appendFile output_fname ",," + ; appendFile output_fname (filter (/='s') (showComma hlstr)) } + + output_header output_fname (m:ms) = do + { appendFile output_fname ("," ++ m) + ; output_header output_fname ms } + output_header output_fname [] = return () + + high_low results = + let fst = head results + lst = head $ drop ((length results) - 1) results + in (fst,lst) |