Cabal-tests/tests/UnitTests.hs

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