packages feed

shaker 0.4 → 0.4.1

raw patch · 18 files changed

+202/−122 lines, 18 files

Files

shaker.cabal view
@@ -1,5 +1,5 @@ name: shaker-version: 0.4+version: 0.4.1 cabal-version: >= 1.8 build-type: Custom license: BSD3@@ -43,16 +43,20 @@   .   [@compile@] Compile the project. Targets of the compilation are main files (in case of executable) and exposed modules (in case of library).   .-  [@fullcompile@] Compile all hs files found in source directory. It is usefull to compile test sources. Since it is not possible to compile multiple modules with main, all modules with a main function are excluded.+  [@fullcompile@] Compile all hs files found in source directory. It is usefull to compile sources not declared in cabal. Since it is not possible to compile multiple modules with main, all modules with a main function are excluded.   .   [@help@] Print all available action.   .   [@clean@] Clean the directory containing .o and .hi files.   .-  [@test@] Launch all quickcheck properties and hunit tests of the project using test-framework. You can provide a regexp as argument and shaker will execute all tests located in modules matching the regexp. Quickcheck properties and HUnit tests are automatically discovered using GHC Api. All functions begining with “prop_” are considered as quickcheck properties and all functions of type Test.HUnit.Lang.Assertion are considered as HUnit tests. +  [@test@] Launch all quickcheck properties and hunit tests of the project using test-framework. You can provide one or several regexps as argument and shaker will execute all tests matching one regexp. Quickcheck properties and HUnit tests are automatically discovered using GHC Api. All functions begining with “prop_” are considered as quickcheck properties and all functions of type Test.HUnit.Lang.Assertion and TestCase are considered as HUnit tests.    .+  [@test-module@] Same as test but test-module takes one or several module patterns as arguments.+  .   [@itest@] Launch all quickcheck properties and hunit tests using test-framework on compiled modules. Same as test, you can give a regexp as argument. This action is only useful when used with continuous action.    .+  [@itest-module@] Same as itest but itest-module takes one or several module patterns as arguments.+  .   [@quit@] Exit the application. You can also use ^C or ^D to exit shaker.   .    /Examples with interactive prompt/@@ -69,9 +73,13 @@   .   [@% ~itest@] Switch to continuous mode and execute tests on compiled modules.   .-  [@% test Regex@] Launch all tests in modules containing Regex+  [@% test prop_.*@] Execute all quickcheck properties of the project.    .-  [@% ~itest Regex@] Launch all tests in modules containing Regex only when Regex is build.+  [@% test testExecute.* testFilter.* @] Execute all tests matching testExecute.* or testFilter.*+  .+  [@% test-module Regex Refle@] Launch all tests in modules matching Regex.* or Refle.*+  .+  [@% ~itest-module Regex Refle@] Launch all tests in modules matching Regex.* or Refle.* only when they are build.   .    /Examples with command-line/   .@@ -100,7 +108,7 @@ source-repository this   type:     git   location: git://github.com/bonnefoa/Shaker.git -  tag:      0.4+  tag:      0.4.1  Library    ghc-options: -Wall -fno-warn-orphans @@ -109,7 +117,6 @@     Shaker.Parser     Shaker.Action.Standard     Shaker.Action.Test-    Shaker.Action.Execute     Shaker.Action.Compile     Shaker.Conductor     Shaker.Config
− src/Shaker/Action/Execute.hs 
@@ -1,28 +0,0 @@-module Shaker.Action.Execute- where-  -import Shaker.Type-import Shaker.Reflexivite-import Control.Monad.Reader-import Control.Arrow-import Data.List--runExecute :: Plugin-runExecute = do-  arg <- asks argument-  launchFunction arg--launchFunction :: Maybe String -> Plugin -launchFunction Nothing = lift $ putStrLn "No action to execute. Give an argument of ModuleName.functionName. The function should be of type IO()"-launchFunction (Just actStr) = runFunction runnableFunction-  where runnableFunction = parseModuleAndAction actStr--parseModuleAndAction :: String -> RunnableFunction-parseModuleAndAction actStr -  | '>' `elem` actStr = RunnableFunction (split ',' moduleStr)  functionStr-  | otherwise = RunnableFunction [""] actStr-  where (functionStr, moduleStr) =  first reverse . second ( reverse . tail )  . span (/= '>') . reverse $ actStr--split :: Char -> String -> [String]-split sep = takeWhile (not . null) . unfoldr (Just . span (/= sep) . dropWhile (== sep))-
src/Shaker/Action/Test.hs view
@@ -7,20 +7,33 @@ import Language.Haskell.TH  runTestFramework :: Plugin -runTestFramework = collectAllModulesForTest  >>= runTestFramework'-        +runTestFramework = collectAllModulesForTest >>= getModulesWithFunctionFiltering  >>= runTestFramework'+ runIntelligentTestFramework :: Plugin-runIntelligentTestFramework = collectChangedModulesForTest >>= runTestFramework'+runIntelligentTestFramework = collectChangedModulesForTest >>= getModulesWithFunctionFiltering >>= runTestFramework' +runModuleTestFramework :: Plugin +runModuleTestFramework = collectAllModulesForTest >>= getModulesWithModuleFiltering >>= runTestFramework' ++runModuleIntelligentTestFramework :: Plugin+runModuleIntelligentTestFramework = collectChangedModulesForTest >>= getModulesWithModuleFiltering >>= runTestFramework'++getModulesWithModuleFiltering :: [ModuleMapping] -> Shaker IO ( [ModuleMapping] )+getModulesWithModuleFiltering module_list = asks argument >>= return . process+  where process [] = module_list+        process list = concatMap (filterModulesWithPattern module_list) list++getModulesWithFunctionFiltering :: [ModuleMapping] -> Shaker IO ([ModuleMapping] ) +getModulesWithFunctionFiltering module_list = asks argument >>= +  return . removeNonTestModule . filterFunctionsWithPatterns module_list+ runTestFramework' :: [ModuleMapping] -> Plugin runTestFramework' modules = do-  arg <- asks argument -  let filtered_mod = (filterModulesWithPattern arg . removeNonTestModule) modules -  let import_modules = base_modules ++ map cfModuleName filtered_mod-  resolvedExp <- lift $ runQ (listTestFrameworkGroupList filtered_mod)+  let import_modules = base_modules ++ map cfModuleName modules+  resolvedExp <- lift $ runQ (listTestFrameworkGroupList modules)   let function =  filter (/= '\n') $ pprint resolvedExp   lift $ putStrLn function   runFunction $ RunnableFunction import_modules ("defaultMain $ " ++ function)    return () -  where base_modules =["Test.Framework", "Test.Framework.Providers.HUnit", "Test.Framework.Providers.QuickCheck2", "Test.QuickCheck", "Test.HUnit", "Prelude" ] +  where base_modules =["Data.Maybe","Shaker.SourceHelper","Test.Framework", "Test.Framework.Providers.HUnit", "Test.Framework.Providers.QuickCheck2", "Test.QuickCheck", "Test.HUnit", "Prelude" ]
src/Shaker/Cabal/CabalInfo.hs view
@@ -98,9 +98,9 @@ toDynFlags :: [String] -> [String] -> DynFlags -> DynFlags toDynFlags sourceDirs packagesToExpose dnFlags = dnFlags {   importPaths = sourceDirs-  ,outputFile = Just "target/Main"-  ,objectDir = Just "target"-  ,hiDir = Just "target"+  ,outputFile = Just "dist/shakerTarget/Main"+  ,objectDir = Just "dist/shakerTarget"+  ,hiDir = Just "dist/shakerTarget"   ,verbosity = 1   ,ghcLink = NoLink   ,packageFlags = map ExposePackage packagesToExpose
src/Shaker/Conductor.hs view
@@ -81,9 +81,9 @@  -- | Execute a single action with argument executeAction' :: Action -> Shaker IO()-executeAction' (ActionWithArg actKey arg) = do +executeAction' (ActionWithArg actKey args) = do    plMap <- asks pluginMap -  local (\shIn -> shIn {argument = Just arg} ) $ fromJust $ actKey `M.lookup` plMap+  local (\shIn -> shIn {argument = args} ) $ fromJust $ actKey `M.lookup` plMap  -- | Execute a single action without argument executeAction' (Action actKey) = do
src/Shaker/Config.hs view
@@ -13,7 +13,7 @@   listenerInput = defaultListenerInput,   pluginMap = defaultPluginMap,   commandMap = defaultCommandMap-  ,argument = Nothing+  ,argument = []   ,modifiedInfoFiles = []   }
src/Shaker/Io.hs view
@@ -69,7 +69,7 @@ isFileContainingTH fp = isFileContaining fp (L.pack "$(" `L.isInfixOf`)  isFileContainingMain :: FilePath -> IO Bool-isFileContainingMain fp = isFileContaining fp (\a -> L.pack "main " `L.isPrefixOf` a || L.pack "main:" `L.isPrefixOf` a)+isFileContainingMain fp = isFileContaining fp $ (\a -> L.pack "main " `L.isPrefixOf` a || L.pack "main:" `L.isPrefixOf` a) . L.dropWhile (== ' ')  isFileContaining :: FilePath -> (L.ByteString -> Bool) -> IO Bool isFileContaining fp pat = do
src/Shaker/Parser.hs view
@@ -12,9 +12,8 @@  -- | Parse the given string to a Command parseCommand :: String -> ShakerInput -> Either ParseError Command-parseCommand str shIn = parse (typeCommand cmd_map) "parseCommand" process_input+parseCommand str shIn = parse (typeCommand cmd_map) "parseCommand" str   where cmd_map = commandMap shIn-        process_input = map toLower str  -- | Parse a Command typeCommand :: CommandMap -> GenParser Char st Command@@ -37,17 +36,17 @@ typeAction :: CommandMap -> GenParser Char st Action typeAction cmMap = skipMany (char ' ') >>   typeShakerAction cmMap >>= \shAct -> -  optionMaybe (parseArgument cmMap) >>= \arg ->+  optionMaybe (many $ parseArgument cmMap) >>= \arg ->   skipMany (char ' ') >>    case arg of        Nothing -> return $ Action shAct-       Just str -> return $ ActionWithArg shAct str+       Just [] -> return $ Action shAct +       Just list -> return $ ActionWithArg shAct list  parseArgument :: CommandMap -> GenParser Char st String parseArgument cmMap =    skipMany (char ' ') >>-  mapM_ (\a -> notFollowedBy $ string (a++" ") ) (M.keys cmMap) >>  -  mapM_ (\a -> notFollowedBy $ string (a++"\n") ) (M.keys cmMap) >>  +  mapM_ notFollowedBy (parseMapAction cmMap) >>     many1 (noneOf " \n") >>= \str ->   skipMany (char ' ') >>   return str @@ -59,11 +58,19 @@   notFollowedBy (noneOf " \n") >>    skipMany (char ' ') >> return res +parseMapAction :: CommandMap -> [GenParser Char st ShakerAction]+parseMapAction cmMap = map check_key key_list+  where key_list = M.toList cmMap+        check_key (key,value) = try (walk key >> notFollowedBy (noneOf " \n" ) ) >> return value++walk :: String -> GenParser Char st ()+walk [] = return ()+walk (x:xs) = caseChar x >> walk xs+  where caseChar c | isAlpha c = char (toLower c) <|> char (toUpper c)+                   | otherwise = char c+ -- | Parse the continuous tag (~) typeDuration :: GenParser Char st Duration typeDuration = skipMany (char ' ') >>   option OneShot (char '~' >> return Continuous)--parseMapAction :: CommandMap -> [GenParser Char st ShakerAction]-parseMapAction cmMap = map (\(k,v) -> try (string k) >> return v) (M.toList cmMap)
src/Shaker/PluginConfig.hs view
@@ -16,9 +16,10 @@                 (FullCompile,runFullCompile ),                 (Help,runHelp),                 (InvalidAction,runInvalidAction),---                (Execute,runExecute),                 (TestFramework , runTestFramework),+                (ModuleTestFramework , runModuleTestFramework),                 (IntelligentTestFramework , runIntelligentTestFramework),+                (IntelligentModuleTestFramework, runModuleIntelligentTestFramework),                 (Empty,runEmpty),                 (Clean,runClean),                 (Quit,runExit)@@ -30,9 +31,10 @@             ("compile",Compile),             ("fullcompile",FullCompile),             ("help", Help),---            ("Execute", Execute),             ("test", TestFramework ),+            ("test-module", ModuleTestFramework),             ("itest", IntelligentTestFramework ),+            ("itest-module", IntelligentModuleTestFramework),             ("clean",Clean),             ("quit",Quit)           ]
src/Shaker/Reflexivite.hs view
@@ -1,4 +1,4 @@-module Shaker.Reflexivite(+module Shaker.Reflexivite (   ModuleMapping(..)   ,RunnableFunction(..)   -- * Collect module information functions@@ -11,8 +11,9 @@   -- * Template haskell generator   ,listAllTestFrameworkGroupList   ,filterModulesWithPattern+  ,filterFunctionsWithPatterns   ,listTestFrameworkGroupList -)+  )  where  import Data.List@@ -39,7 +40,8 @@ -- | Mapping between module name (to import) and test to execute data ModuleMapping = ModuleMapping {   cfModuleName :: String -- ^ Complete name of the module -  ,cfHunitName :: [String] -- ^ Hunit test function names+  ,cfHunitAssertion :: [String] -- ^ Hunit assertions+  ,cfHunitTestCase :: [String] -- ^ Hunit test case to process for test-framework   ,cfPropName :: [String] -- ^ QuickCheck test function names  }  deriving (Show,Eq)@@ -61,9 +63,10 @@ collectAllModulesForTest :: Shaker IO [ModuleMapping] collectAllModulesForTest = do    (cpIn, cfFlList) <- initializeFilesForCompilation -  lift $ runGhc (Just libdir) $ do +  allModules <- lift $ runGhc (Just libdir) $ do          _ <- ghcCompile $ runReader (fillCompileInputWithStandardTarget cpIn) cfFlList         collectAllModules' >>= mapM getModuleMapping +  return . removeNonTestModule $ allModules  -- | Collect all non-main modules  collectAllModules :: Shaker IO [ModSummary]@@ -89,10 +92,11 @@   (cpIn, cfFlList) <- initializeFilesForCompilation    modInfoFiles <- asks modifiedInfoFiles   let modFilePaths = (map fileInfoFilePath modInfoFiles)-  lift $ runGhc (Just libdir) $ do +  changed_modules <- lift $ runGhc (Just libdir) $ do             let processedCpIn = runReader (setAllHsFilesAsTargets cpIn >>= removeFileWithMain ) cfFlList            _ <- initializeGhc processedCpIn            collectChangedModulesForTest' modFilePaths processedCpIn+  return . removeNonTestModule $ changed_modules  collectAllModules' :: GhcMonad m => m [ModSummary]  collectAllModules' = do @@ -100,7 +104,6 @@   let sort_mss = flattenSCCs $ topSortModuleGraph True mss Nothing   return sort_mss          - collectChangedModules' :: GhcMonad m => [FilePath] -> m [ModSummary]  collectChangedModules' modFilePaths = collectAllModules' >>= filterM (isModuleNeedCompilation modFilePaths)  @@ -139,16 +142,20 @@ getModuleMapping  modSum = do    mayModuleInfo <- getModuleInfo $  ms_mod modSum   let props = getQuickCheckFunction mayModuleInfo-  let hunits = getHunitFunctions mayModuleInfo-  return $ ModuleMapping modName hunits props+  let hunits = getHunitAssertions mayModuleInfo+  let testCases = getHunitTestCase mayModuleInfo+  return $ ModuleMapping modName hunits testCases props   where modName = (moduleNameString . moduleName . ms_mod) modSum                 getQuickCheckFunction :: Maybe ModuleInfo -> [String] getQuickCheckFunction = getFunctionNameWithPredicate ("prop_" `isPrefixOf`)  -getHunitFunctions :: Maybe ModuleInfo -> [String]-getHunitFunctions = getFunctionTypeWithPredicate (== "Test.HUnit.Lang.Assertion") +getHunitAssertions :: Maybe ModuleInfo -> [String]+getHunitAssertions = getFunctionTypeWithPredicate (== "Test.HUnit.Lang.Assertion")  +getHunitTestCase :: Maybe ModuleInfo -> [String]+getHunitTestCase = getFunctionTypeWithPredicate (== "Test.HUnit.Base.Test") + getFunctionTypeWithPredicate :: (String -> Bool) -> Maybe ModuleInfo -> [String] getFunctionTypeWithPredicate _ Nothing = [] getFunctionTypeWithPredicate predicat (Just modInfo) = map snd $ filter ( predicat . fst)  typeList@@ -157,7 +164,8 @@  getFunctionNameWithPredicate :: (String -> Bool) -> Maybe ModuleInfo -> [String] getFunctionNameWithPredicate _ Nothing = []-getFunctionNameWithPredicate predicat (Just modInfo) = filter predicat nameList+getFunctionNameWithPredicate predicat (Just modInfo) = +  filter predicat nameList    where idList = getIdList modInfo          nameList = map getFunctionNameFromId idList  @@ -182,37 +190,55 @@  -- | Remove all modules which does not contain test removeNonTestModule :: [ModuleMapping] -> [ModuleMapping]-removeNonTestModule = filter (\modMap -> notEmpty (cfHunitName modMap) || notEmpty (cfPropName modMap) )+removeNonTestModule = filter (\modMap -> notEmpty (cfHunitAssertion modMap) || notEmpty (cfPropName modMap) || notEmpty (cfHunitTestCase modMap) )   where notEmpty = not.null  -- * Test framework integration   -- | Generate a test group for a given module getSingleTestFrameworkGroup :: ModuleMapping -> Exp-getSingleTestFrameworkGroup modMap = AppE first_arg second_arg-  where first_arg = AppE (VarE .mkName $ "testGroup") (LitE (StringL $ cfModuleName modMap))-        second_arg = ListE $ list_prop ++ list_hunit -        list_prop = map getSingleFrameworkQuickCheck $ cfPropName modMap-        list_hunit = map getSingleFrameworkHunit $ cfHunitName modMap+getSingleTestFrameworkGroup modMap = foldl1 AppE [process_to_group_exp, test_case_tuple_list, list_assertion, list_prop]+  where process_to_group_exp = AppE (VarE .mkName $ "processToTestGroup") (LitE (StringL $ cfModuleName modMap))+        -- list_test = AppE (AppE (VarE $ mkName "++") testcase_exp)  (ListE $ list_prop ++ list_assertion)+        list_prop = ListE $ map getSingleFrameworkQuickCheck $ cfPropName modMap+        list_assertion = ListE $ map getSingleFrameworkHunit $ cfHunitAssertion modMap+        test_case_tuple_list = convertHunitTestCaseToTuples (cfHunitTestCase modMap) +convertHunitTestCaseToTuples :: [String] -> Exp+convertHunitTestCaseToTuples = ListE . map convertToTuple +  where convertToTuple name = TupE [LitE (StringL name), VarE $ mkName name ]+ -- | Generate an expression for a single hunit test getSingleFrameworkHunit :: String -> Exp -getSingleFrameworkHunit hunitName = AppE first_arg second_arg -  where first_arg = AppE ( VarE $ mkName "testCase") (LitE $ StringL hunitName)-        second_arg = VarE . mkName $ hunitName+getSingleFrameworkHunit hunitName = AppE testcase_with_name_exp assertion_exp+  where testcase_with_name_exp = AppE ( VarE $ mkName "testCase") (LitE $ StringL hunitName)+        assertion_exp = VarE . mkName $ hunitName  -- | Generate an expression for a single quickcheck property getSingleFrameworkQuickCheck :: String -> Exp-getSingleFrameworkQuickCheck propName = AppE first_arg second_arg +getSingleFrameworkQuickCheck propName = AppE testproperty_with_name_exp property_exp    where canonical_name = tail . dropWhile (/= '_') $ propName -        first_arg = AppE ( VarE $ mkName "testProperty") (LitE $ StringL canonical_name)-        second_arg = VarE . mkName $ propName+        testproperty_with_name_exp = AppE ( VarE $ mkName "testProperty") (LitE $ StringL canonical_name)+        property_exp = VarE . mkName $ propName  -- * utility functions   -- | Include only module matching the given pattern-filterModulesWithPattern :: Maybe String -> [ModuleMapping] -> [ModuleMapping]-filterModulesWithPattern Nothing mod_map = mod_map-filterModulesWithPattern (Just pattern) mod_map = filter (\a -> cfModuleName a `elem` filtered_mod_list) mod_map+filterModulesWithPattern :: [ModuleMapping]-> String -> [ModuleMapping]+filterModulesWithPattern mod_map pattern = filter (\a -> cfModuleName a `elem` filtered_mod_list) mod_map   where mod_list = map cfModuleName mod_map         filtered_mod_list = processListWithRegexp mod_list [] [pattern]++filterFunctionsWithPatterns :: [ModuleMapping] -> [String] -> [ModuleMapping]+filterFunctionsWithPatterns mod_map patterns = map (flip filterFunctionsWithPatterns' patterns) mod_map++filterFunctionsWithPatterns' :: ModuleMapping -> [String] -> ModuleMapping+filterFunctionsWithPatterns' (ModuleMapping name hunitAssertions hunitTestCases properties) patterns = +  ModuleMapping{+    cfModuleName = name+    ,cfHunitAssertion = processListWithRegexp hunitAssertions [] patterns+    ,cfHunitTestCase = processListWithRegexp hunitTestCases [] patterns+    ,cfPropName = processListWithRegexp properties [] patterns+  }++
src/Shaker/SourceHelper.hs view
@@ -9,6 +9,7 @@   ,removeFileWithMain   ,removeFileWithTemplateHaskell   ,fillCompileInputWithStandardTarget+  ,processToTestGroup    -- * GHC Compile management   ,initializeGhc   ,ghcCompile@@ -20,6 +21,7 @@  import GHC import Data.List+import Data.Maybe import Shaker.Io import Shaker.Type @@ -32,6 +34,10 @@  import System.Directory +import Test.HUnit as H+import Test.Framework.Providers.API as T (Test, testGroup)+import Test.Framework.Providers.HUnit + type CompileR = Reader [CompileFile]  data CompileFile = CompileFile {@@ -101,6 +107,14 @@ -- containing main and template haskell fillCompileInputWithStandardTarget :: CompileInput -> CompileR CompileInput  fillCompileInputWithStandardTarget cpIn = setAllHsFilesAsTargets cpIn >>= removeFileWithMain >>=removeFileWithTemplateHaskell++processToTestGroup :: String -> [(String, H.Test)] -> [T.Test] -> [T.Test] -> T.Test+processToTestGroup testName testCaseList assertionList propertyList = testGroup testName $ concat [listHunitTestCase, assertionList, propertyList]+    where listHunitTestCase = mapMaybe convertTestCaseToTestFrameworkTestCase testCaseList+    +convertTestCaseToTestFrameworkTestCase :: (String, H.Test) -> Maybe T.Test+convertTestCaseToTestFrameworkTestCase (name, TestCase assertion) = Just $ testCase name assertion+convertTestCaseToTestFrameworkTestCase _ = Nothing  -- | Configure and load targets of compilation.  -- It is possible to exploit the compilation result after this step.
src/Shaker/Type.hs view
@@ -31,7 +31,7 @@ -- | Action represents the differents action with arguments data Action =    Action ShakerAction-  | ActionWithArg ShakerAction String+  | ActionWithArg ShakerAction [String]   deriving (Show,Eq,Ord)   -- | The input mvar is used to push the parsed command@@ -47,7 +47,9 @@ 	Compile -- ^ Compile sources with ghc 	| FullCompile -- ^ Compile all hs sources with ghc         | TestFramework -- ^ Execute both quickcheck and hunit using test framework+        | ModuleTestFramework -- ^ Execute both quickcheck and hunit using test framework with module filtering         | IntelligentTestFramework -- ^ Execute both quickcheck and hunit using test framework on recompiled modules+        | IntelligentModuleTestFramework -- ^ Execute both quickcheck and hunit using test framework on recompiled modules         | InvalidAction -- ^ Display an error when invalid action is inputed 	| Help -- ^ Display the help         | Execute -- ^ Execute a command@@ -66,14 +68,13 @@   ,listenerInput :: ListenerInput   ,pluginMap :: PluginMap   ,commandMap :: CommandMap-  ,argument :: Maybe String+  ,argument :: [String]   ,modifiedInfoFiles :: [FileInfo]   ,threadData :: ThreadData    ,inputState :: InputState   }     data ThreadData = ThreadData {-    -- processToken :: Token     listenToken :: Token      ,quitToken :: Token      ,threadIdListenList :: ThreadIdList@@ -134,7 +135,7 @@ defaultCompileInput = CompileInput {   cfSourceDirs= ["src/","testsuite/tests/"]   ,cfDescription = "Default Compilation"-  ,cfCompileTarget =  "target"  +  ,cfCompileTarget =  "dist/shakerTarget"     ,cfDynFlags = defaultCompileFlags     ,cfCommandLineFlags = ["-Wall"]   ,cfTargetFiles = []
testsuite/tests/RunTestTH.hs view
@@ -2,6 +2,7 @@ module Main  where +import Shaker.SourceHelper import Shaker.TestTH import Shaker.Cabal.CabalInfoTest import Shaker.Action.CompileTest
testsuite/tests/Shaker/Action/CompileTest.hs view
@@ -10,15 +10,15 @@ testRunCompileProject :: Assertion testRunCompileProject =    runReaderT runCompile  testShakerInput >> -  getDirectoryContents "target/Shaker" >>= \cont ->-  doesFileExist "target/Shaker/Action/CompileTest.o" >>= \ex ->-  doesFileExist "target/Shaker/Action/CompileTest.hi" >>= \ex2 ->+  getDirectoryContents "dist/shakerTarget/Shaker" >>= \cont ->+  doesFileExist "dist/shakerTarget/Shaker/Action/CompileTest.o" >>= \ex ->+  doesFileExist "dist/shakerTarget/Shaker/Action/CompileTest.hi" >>= \ex2 ->   assertBool ("File .o and hi should exists "++ show cont) (ex && ex2)  testRunFullCompile :: Assertion testRunFullCompile = do   runReaderT runFullCompile testShakerInput-  cont <- getDirectoryContents "target/Shaker" -  ex <- doesFileExist "target/Shaker/Conductor.o" +  cont <- getDirectoryContents "dist/shakerTarget/Shaker" +  ex <- doesFileExist "dist/shakerTarget/Shaker/Conductor.o"    assertBool ("Conductor.o should exist, got "++show cont) ex
testsuite/tests/Shaker/Cabal/CabalInfoTest.hs view
@@ -37,9 +37,9 @@ testCompileWithLocalSource =  runTestOnDirectory "testsuite/tests/resources/noSourceConfig" $ do  shIn <- defaultCabalInput  runReaderT runCompile shIn- ex <- doesFileExist "target/Main.o" + ex <- doesFileExist "dist/shakerTarget/Main.o"   runReaderT runClean shIn- ex2 <- doesFileExist "target/Main.o" + ex2 <- doesFileExist "dist/shakerTarget/Main.o"   ex && not ex2 @? "file main should exist and be cleaned"
testsuite/tests/Shaker/ParserTest.hs view
@@ -8,6 +8,7 @@ import Shaker.Parser import Shaker.Config import Shaker.PluginConfig+import Shaker.Properties  import Data.Map (toList) import Data.Char  @@ -38,16 +39,16 @@  instance Arbitrary ActionString where   arbitrary = do -        str <- listOf $ elements ['a'..'z'] -        proc str +        list_str <- createListName+        proc (filter (/="") list_str)         where                -- Build action string without arg-              proc "" = oneof [+              proc [] = oneof [                          elements $ map (constructActionString . first (map toUpper)) listCommandMap                           ,elements $ map constructActionString listCommandMap                         ]               -- build action string with args-              proc str = elements $ map (\(key,value) -> ActionString (key ++ " " ++ trim str) (ActionWithArg value str)  ) listCommandMap +              proc list = elements $ map (\(key,value) -> ActionString (key ++ " " ++ unwords list) (ActionWithArg value list)  ) listCommandMap                listCommandMap = toList defaultCommandMap   trim :: String -> String
testsuite/tests/Shaker/Properties.hs view
@@ -38,7 +38,8 @@               name <- createShortName               listHunitName <- listOf createShortName                listPropName <- listOf createShortName -              return $ ModuleMapping name listHunitName listPropName+              listTestCases <- listOf createShortName +              return $ ModuleMapping name listHunitName listTestCases listPropName  genSmallNumber :: Gen Int genSmallNumber = elements [0..10]
testsuite/tests/Shaker/ReflexiviteTest.hs view
@@ -5,6 +5,7 @@ import Test.QuickCheck   import Data.List+ import Control.Monad.Reader(runReaderT) import Shaker.Reflexivite import Shaker.Type@@ -14,23 +15,57 @@ import System.Time import System.Directory import System.FilePath +import Language.Haskell.TH -testRunReflexivite :: Assertion-testRunReflexivite =  do-  modMapLst <- runReaderT collectAllModulesForTest testShakerInput-  length modMapLst > 1 @? "Should have more than one module, got : "++ show (length modMapLst)-  any ( \(ModuleMapping nm _ _) -> nm == "Shaker.ReflexiviteTest") modMapLst @? -    "Should have module Shaker.ReflexiviteTest, got " ++ show modMapLst-  let (Just regexpModMap)  = find (\(ModuleMapping nm _ _) -> nm == "Shaker.RegexTest" ) modMapLst-  any (== "prop_filterListAll") (cfPropName regexpModMap) @? "Should contain regexp module with quickechck properties prop_filterListAll, got "-    ++ show (cfPropName regexpModMap)-  let (Just reflexiviteModMap)  = find (\(ModuleMapping nm _ _) -> nm == "Shaker.ReflexiviteTest" ) modMapLst-  any (== "testRunReflexivite") (cfHunitName reflexiviteModMap) @? "Should contain reflexivite test module with hunit test testRunReflexivite, got "-    ++ show (cfHunitName reflexiviteModMap)-  not ( any (== "testShakerInput") (cfHunitName reflexiviteModMap) ) @? "Should not contain function testShakerInput, got "-    ++ show (cfHunitName reflexiviteModMap)-  not (any (\a ->cfModuleName a == "Shaker.RunTestTH") modMapLst) @? "Should have excluded RunTestTH, got " ++ show modMapLst+-- * Module mapping construction test +abstractTestModuleMapping :: ([ModuleMapping] -> Assertion) -> Assertion+abstractTestModuleMapping predicat = runReaderT collectAllModulesForTest testShakerInput >>= predicat++testModuleMappingLength :: Assertion+testModuleMappingLength = abstractTestModuleMapping predicat+  where predicat modMapLst = length modMapLst > 1 @? "Should have more than one module, got : "++ show (length modMapLst) ++testModuleMappingContainReflexiviteTest :: Assertion+testModuleMappingContainReflexiviteTest = abstractTestModuleMapping predicat+  where predicat modMapLst = any ( \mm -> cfModuleName mm == "Shaker.ReflexiviteTest") modMapLst @?  "Should have module Shaker.ReflexiviteTest, got " ++ show modMapLst++testModuleMappingShouldNotContainRunTestTH :: Assertion+testModuleMappingShouldNotContainRunTestTH = abstractTestModuleMapping predicat+  where predicat modMapLst = not (any (\a ->cfModuleName a == "Shaker.RunTestTH") modMapLst) @? "Should have excluded RunTestTH, got " ++ show modMapLst++-- * Reflexivite module Test ++abstractModuleMappingReflexiviteTest :: (ModuleMapping -> Assertion) -> Assertion+abstractModuleMappingReflexiviteTest predicat = do+  modMapLst <- runReaderT collectAllModulesForTest testShakerInput +  let (Just reflexiviteModMap)  = find (\mm -> cfModuleName mm == "Shaker.ReflexiviteTest" ) modMapLst+  predicat reflexiviteModMap++testReflexiviteTestContainQuickcheckProperty :: Assertion+testReflexiviteTestContainQuickcheckProperty = abstractModuleMappingReflexiviteTest predicat+  where predicat reflexiviteModule = any (== "prop_filterModMap_include_all") (cfPropName reflexiviteModule) +          @? "ReflexiviteModule should contains quickechck properties prop_filterModMap_include_all, got " ++ show (cfPropName reflexiviteModule)++testReflexiviteTestContainHunitAssertion :: Assertion+testReflexiviteTestContainHunitAssertion = abstractModuleMappingReflexiviteTest predicat+  where predicat reflexiviteModule = any (== "testReflexiviteTestContainHunitAssertion") (cfHunitAssertion reflexiviteModule) +          @? "ReflexiviteModule should contain hunit assertion testReflexiviteTestContainHunitAssertion, got " ++ show (cfHunitAssertion reflexiviteModule)++testReflexiviteTestShouldContainTestCase :: Assertion+testReflexiviteTestShouldContainTestCase = abstractModuleMappingReflexiviteTest predicat+  where predicat reflexiviteModule = any (== "testHunitTestCaseDetection") (cfHunitTestCase reflexiviteModule) +          @? "ReflexiviteModule should contain testCase testHunitTestCaseDetection, got " ++ show (cfHunitTestCase reflexiviteModule)+  +testHunitTestCaseDetection :: Test+testHunitTestCaseDetection = TestCase $ True @? "Trivial"++testListAllTestFrameworkGroupList :: Assertion+testListAllTestFrameworkGroupList = do+  resolved_exp <- runQ $ listAllTestFrameworkGroupList testShakerInput+  let function =  filter (/= '\n') $ pprint resolved_exp+  "processToTestGroup \"Shaker.ReflexiviteTest\" [(\"testHunitTestCaseDetection\"" `isInfixOf` function @? "listAllTestFrameworkGroupList should have correctly setted hunit to test framework conversion"+ aFun :: String -> IO () aFun tempFp = do   exist <- doesDirectoryExist tempFp@@ -76,7 +111,7 @@   length exp_one_modules == 1 @? "One module should need compilation"   let module_mapping = head exp_one_modules    cfModuleName module_mapping == "Shaker.SourceHelperTest" @? "module SourceHelperTest should need recompilation, got " ++ cfModuleName module_mapping -  length (cfHunitName module_mapping) >2  @? "module SourceHelperTest should have hunit test" +  length (cfHunitAssertion module_mapping) >2  @? "module SourceHelperTest should have hunit test"     testCollectChangedModulesForTestQuickCheck :: Assertion testCollectChangedModulesForTestQuickCheck =  do@@ -96,13 +131,13 @@   let modFileInfo = map (\a -> FileInfo a (TOD 0 0) ) sources   exp_one_modules <- runReaderT collectChangedModulesForTest testShakerInput {modifiedInfoFiles = modFileInfo }   length exp_one_modules == 1 @? "One module should need compilation"-  + prop_filterModMap_include_all :: [ModuleMapping] -> Bool prop_filterModMap_include_all modMap = modMap == res-  where res = filterModulesWithPattern (Just ".*") modMap +  where res = filterModulesWithPattern modMap ".*"          prop_filterModMap_include_some :: [ModuleMapping] -> Property prop_filterModMap_include_some modMap = (not . null) modMap ==> head res == head modMap   where module_name = (cfModuleName . head) modMap-        res = filterModulesWithPattern (Just module_name) modMap +        res = filterModulesWithPattern modMap module_name