Cabal-tests/tests/CheckTests.hs

   1 module Main
   2     ( main
   3     ) where
   4
   5 import Test.Tasty
   6 import Test.Tasty.ExpectedFailure
   7 import Test.Tasty.Golden.Advanced (goldenTest)
   8
   9 import Data.Algorithm.Diff                    (PolyDiff (..), getGroupedDiff)
  10 import Distribution.Fields                    (runParseResult)
  11 import Distribution.PackageDescription.Check  (checkPackage)
  12 import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
  13 import Distribution.Parsec
  14 import Distribution.Utils.Generic             (fromUTF8BS, toUTF8BS)
  15 import System.Directory                       (setCurrentDirectory)
  16 import System.Environment                     (getArgs, withArgs)
  17 import System.FilePath                        (replaceExtension, (</>))
  18
  19 import qualified Data.ByteString       as BS
  20 import qualified Data.ByteString.Char8 as BS8
  21 import qualified Data.List.NonEmpty    as NE
  22
  23 tests :: TestTree
  24 tests = checkTests
  25
  26 -------------------------------------------------------------------------------
  27 -- Regressions
  28 -------------------------------------------------------------------------------
  29
  30 checkTests :: TestTree
  31 checkTests = testGroup "regressions"
  32     [ checkTest "nothing-unicode.cabal"
  33     , checkTest "haddock-api-2.18.1-check.cabal"
  34     , checkTest "issue-774.cabal"
  35     , checkTest "extensions-paths-5054.cabal"
  36     , checkTest "pre-1.6-glob.cabal"
  37     , checkTest "pre-2.4-globstar.cabal"
  38     , checkTest "bad-glob-syntax.cabal"
  39     , checkTest "globstar-literal.cabal"
  40     , checkTest "pre-3.8-globstar-literal.cabal"
  41     , checkTest "cc-options-with-optimization.cabal"
  42     , checkTest "cxx-options-with-optimization.cabal"
  43     , checkTest "ghc-option-j.cabal"
  44     , checkTest "multiple-libs-2.cabal"
  45     , checkTest "assoc-cpp-options.cabal"
  46     , checkTest "public-multilib-1.cabal"
  47     , checkTest "public-multilib-2.cabal"
  48     , checkTest "all-upper-bound.cabal"
  49     , checkTest "issue-6288-a.cabal"
  50     , checkTest "issue-6288-b.cabal"
  51     , checkTest "issue-6288-c.cabal"
  52     , checkTest "issue-6288-d.cabal"
  53     , checkTest "issue-6288-e.cabal"
  54     , checkTest "issue-6288-f.cabal"
  55     , checkTest "denormalised-paths.cabal"
  56     , checkTest "issue-7776-a.cabal"
  57     , checkTest "issue-7776-b.cabal"
  58     , checkTest "issue-7776-c.cabal"
  59     , checkTest "issue-8646.cabal"
  60     , checkTest "decreasing-indentation.cabal"
  61     ]
  62
  63 checkTest :: FilePath -> TestTree
  64 checkTest fp = cabalGoldenTest fp correct $ do
  65     contents <- BS.readFile input
  66     let res =  parseGenericPackageDescription contents
  67     let (ws, x) = runParseResult res
  68
  69     return $ toUTF8BS $ case x of
  70         Right gpd      ->
  71             -- Note: parser warnings are reported by `cabal check`, but not by
  72             -- D.PD.Check functionality.
  73             unlines (map (showPWarning fp) ws) ++
  74             unlines (map show (checkPackage gpd))
  75         Left (_, errs) -> unlines $ map (("ERROR: " ++) . showPError fp) $ NE.toList errs
  76   where
  77     input = "tests" </> "ParserTests" </> "regressions" </> fp
  78     correct = replaceExtension input "check"
  79
  80 -------------------------------------------------------------------------------
  81 -- Main
  82 -------------------------------------------------------------------------------
  83
  84 main :: IO ()
  85 main = do
  86     args <- getArgs
  87     case args of
  88         ("--cwd" : cwd : args') -> do
  89             setCurrentDirectory cwd
  90             withArgs args' $ defaultMain tests
  91         _ -> defaultMain tests
  92
  93 cabalGoldenTest :: TestName -> FilePath -> IO BS.ByteString -> TestTree
  94 cabalGoldenTest name ref act = goldenTest name (BS.readFile ref) act cmp upd
  95   where
  96     upd = BS.writeFile ref
  97     cmp x y | x == y = return Nothing
  98     cmp x y = return $ Just $ unlines $
  99         concatMap f (getGroupedDiff (BS8.lines x) (BS8.lines y))
 100       where
 101         f (First xs)  = map (cons3 '-' . fromUTF8BS) xs
 102         f (Second ys) = map (cons3 '+' . fromUTF8BS) ys
 103         -- we print unchanged lines too. It shouldn't be a problem while we have
 104         -- reasonably small examples
 105         f (Both xs _) = map (cons3 ' ' . fromUTF8BS) xs
 106         -- we add three characters, so the changed lines are easier to spot
 107         cons3 c cs = c : c : c : ' ' : cs