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