1{-# LANGUAGE DeriveDataTypeable #-} 2module Main 3 ( main 4 ) where 5 6import Test.Tasty 7import Test.Tasty.Options 8 9import Data.Proxy 10import Data.Typeable 11 12import Distribution.Simple.Utils 13import Distribution.Verbosity 14import Distribution.Compat.Time 15 16import qualified UnitTests.Distribution.Compat.CreatePipe 17import qualified UnitTests.Distribution.Compat.Time 18import qualified UnitTests.Distribution.Compat.Graph 19import qualified UnitTests.Distribution.Simple.Glob 20import qualified UnitTests.Distribution.Simple.Program.GHC 21import qualified UnitTests.Distribution.Simple.Program.Internal 22import qualified UnitTests.Distribution.Simple.Utils 23import qualified UnitTests.Distribution.System 24import qualified UnitTests.Distribution.Utils.Generic 25import qualified UnitTests.Distribution.Utils.NubList 26import qualified UnitTests.Distribution.Utils.ShortText 27import qualified UnitTests.Distribution.Utils.Structured 28import qualified UnitTests.Distribution.Version (versionTests) 29import qualified UnitTests.Distribution.PkgconfigVersion (pkgconfigVersionTests) 30import qualified UnitTests.Distribution.SPDX (spdxTests) 31import qualified UnitTests.Distribution.Types.GenericPackageDescription 32 33tests :: Int -> TestTree 34tests mtimeChangeCalibrated = 35 askOption $ \(OptionMtimeChangeDelay mtimeChangeProvided) -> 36 askOption $ \(GhcPath ghcPath) -> 37 let mtimeChange = if mtimeChangeProvided /= 0 38 then mtimeChangeProvided 39 else mtimeChangeCalibrated 40 in 41 testGroup "Unit Tests" 42 [ testGroup "Distribution.Compat.CreatePipe" 43 UnitTests.Distribution.Compat.CreatePipe.tests 44 , testGroup "Distribution.Compat.Time" 45 (UnitTests.Distribution.Compat.Time.tests mtimeChange) 46 , testGroup "Distribution.Compat.Graph" 47 UnitTests.Distribution.Compat.Graph.tests 48 , testGroup "Distribution.Simple.Glob" 49 UnitTests.Distribution.Simple.Glob.tests 50 , UnitTests.Distribution.Simple.Program.GHC.tests 51 , testGroup "Distribution.Simple.Program.Internal" 52 UnitTests.Distribution.Simple.Program.Internal.tests 53 , testGroup "Distribution.Simple.Utils" $ 54 UnitTests.Distribution.Simple.Utils.tests ghcPath 55 , testGroup "Distribution.Utils.Generic" 56 UnitTests.Distribution.Utils.Generic.tests 57 , testGroup "Distribution.Utils.NubList" 58 UnitTests.Distribution.Utils.NubList.tests 59 , testGroup "Distribution.Utils.ShortText" 60 UnitTests.Distribution.Utils.ShortText.tests 61 , testGroup "Distribution.System" 62 UnitTests.Distribution.System.tests 63 , testGroup "Distribution.Types.GenericPackageDescription" 64 UnitTests.Distribution.Types.GenericPackageDescription.tests 65 , testGroup "Distribution.Version" 66 UnitTests.Distribution.Version.versionTests 67 , testGroup "Distribution.Types.PkgconfigVersion(Range)" 68 UnitTests.Distribution.PkgconfigVersion.pkgconfigVersionTests 69 , testGroup "Distribution.SPDX" 70 UnitTests.Distribution.SPDX.spdxTests 71 , UnitTests.Distribution.Utils.Structured.tests 72 ] 73 74extraOptions :: [OptionDescription] 75extraOptions = 76 [ Option (Proxy :: Proxy OptionMtimeChangeDelay) 77 , Option (Proxy :: Proxy GhcPath) 78 ] 79 80newtype OptionMtimeChangeDelay = OptionMtimeChangeDelay Int 81 deriving Typeable 82 83instance IsOption OptionMtimeChangeDelay where 84 defaultValue = OptionMtimeChangeDelay 0 85 parseValue = fmap OptionMtimeChangeDelay . safeRead 86 optionName = return "mtime-change-delay" 87 optionHelp = return $ "How long to wait before attempting to detect" 88 ++ "file modification, in microseconds" 89 90newtype GhcPath = GhcPath FilePath 91 deriving Typeable 92 93instance IsOption GhcPath where 94 defaultValue = GhcPath "ghc" 95 optionName = return "with-ghc" 96 optionHelp = return "The ghc compiler to use" 97 parseValue = Just . GhcPath 98 99main :: IO () 100main = do 101 (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay 102 let toMillis :: Int -> Double 103 toMillis x = fromIntegral x / 1000.0 104 notice normal $ "File modification time resolution calibration completed, " 105 ++ "maximum delay observed: " 106 ++ (show . toMillis $ mtimeChange ) ++ " ms. " 107 ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange') 108 ++ " for test runs." 109 defaultMainWithIngredients 110 (includingOptions extraOptions : defaultIngredients) 111 (tests mtimeChange') 112