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