summaryrefslogtreecommitdiff
path: root/test/Tests/Command.hs
blob: 9422d2c905a45e2be56417f4c94dab5b60db388c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
module Tests.Command (findPandoc, runTest, tests)
where

import Test.Framework (testGroup, Test )
import Test.Framework.Providers.HUnit
import Test.HUnit ( assertBool )
import System.Environment.Executable (getExecutablePath)
import System.FilePath ( (</>), takeDirectory, splitDirectories,
                         joinPath )
import System.Directory
import System.Exit
import Data.Algorithm.Diff
import Prelude hiding ( readFile )
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Printf
import Text.Pandoc.Process (pipeProcess)

data TestResult = TestPassed
                | TestError ExitCode
                | TestFailed String FilePath [Diff String]
     deriving (Eq)

instance Show TestResult where
  show TestPassed     = "PASSED"
  show (TestError ec) = "ERROR " ++ show ec
  show (TestFailed cmd file d) = '\n' : dash ++
                                 "\n--- " ++ file ++
                                 "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++
                                 dash
    where dash = replicate 72 '-'

showDiff :: (Int,Int) -> [Diff String] -> String
showDiff _ []             = ""
showDiff (l,r) (First ln : ds) =
  printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds
showDiff (l,r) (Second ln : ds) =
  printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds
showDiff (l,r) (Both _ _ : ds) =
  showDiff (l+1,r+1) ds

-- | Find pandoc executable relative to test-pandoc
-- First, try in same directory (e.g. if both in ~/.cabal/bin)
-- Second, try ../pandoc (e.g. if in dist/XXX/build/test-pandoc)
findPandoc :: IO FilePath
findPandoc = do
  testExePath <- getExecutablePath
  let testExeDir = takeDirectory testExePath
  found <- doesFileExist (testExeDir </> "pandoc")
  return $ if found
              then testExeDir </> "pandoc"
              else case splitDirectories testExeDir of
                         [] -> error "test-pandoc: empty testExeDir"
                         xs -> joinPath (init xs) </> "pandoc" </> "pandoc"

-- | Run a test with normalize function, return True if test passed.
runTest :: FilePath  -- ^ pandoc executable path
        -> String    -- ^ Title of test
        -> [String]  -- ^ Options to pass to pandoc
        -> String    -- ^ Input text
        -> String    -- ^ Expected output
        -> Test
runTest pandocPath testname opts inp norm = testCase testname $ do
  let options = ["--quiet", "--data-dir", ".." </> "data"] ++ opts
  let cmd = unwords ((pandocPath </> "pandoc") : options)
  let findDynlibDir [] = Nothing
      findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
      findDynlibDir (_:xs) = findDynlibDir xs
  let mbDynlibDir = findDynlibDir (reverse $ splitDirectories pandocPath)
  let dynlibEnv = case mbDynlibDir of
                       Nothing  -> []
                       Just d   -> [("DYLD_LIBRARY_PATH", d),
                                    ("LD_LIBRARY_PATH", d)]
  let env = dynlibEnv ++ [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
  (ec, outbs) <- pipeProcess (Just env) pandocPath options
                     (UTF8.fromStringLazy inp)
  -- filter \r so the tests will work on Windows machines
  let out = filter (/= '\r') $ UTF8.toStringLazy outbs
  result  <- if ec == ExitSuccess
                then do
                  if out == norm
                     then return TestPassed
                     else return
                          $ TestFailed cmd "expected"
                          $ getDiff (lines out) (lines norm)
                else return $ TestError ec
  assertBool (show result) (result == TestPassed)

tests :: [Test]
tests = [ testGroup "commands"
          [ ]
        ]