summaryrefslogtreecommitdiff
path: root/test/Tests/Command.hs
blob: 3ea8e6cd4c2c7aaab1fae6e3f5af4b41a87e67a9 (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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
module Tests.Command (findPandoc, runTest, tests)
where

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

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 :: String    -- ^ Title of test
        -> String    -- ^ Shell command
        -> String    -- ^ Input text
        -> String    -- ^ Expected output
        -> Test
runTest testname cmd inp norm = testCase testname $ do
  let cmd' = cmd ++ " --quiet --data-dir ../data"
  let findDynlibDir [] = Nothing
      findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
      findDynlibDir (_:xs) = findDynlibDir xs
  let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
                                   takeDirectory $ takeWhile (/=' ') cmd)
  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", "./")]
  let pr = (shell cmd'){ env = Just env' }
  (ec, out', _err) <- readCreateProcessWithExitCode pr inp
  -- filter \r so the tests will work on Windows machines
  let out = filter (/= '\r') out'
  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 = buildTest $ do
  files <- filter (".md" `isSuffixOf`) <$>
               getDirectoryContents "command"
  let cmds = map extractCommandTest files
  return $ testGroup "Command:" cmds

isCodeBlock :: Block -> Bool
isCodeBlock (CodeBlock _ _) = True
isCodeBlock _ = False

extractCode :: Block -> String
extractCode (CodeBlock _ code) = code
extractCode _ = ""

dropPercent :: String -> String
dropPercent ('%':xs) = dropWhile (== ' ') xs
dropPercent xs = xs

runCommandTest :: FilePath -> (Int, String) -> IO Test
runCommandTest pandocpath (num, code) = do
  let codelines = lines code
  let (continuations, r1) = span ("\\" `isSuffixOf`) codelines
  let (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
                   drop 1 r1)
  let (inplines, r3) = break (=="^D") r2
  let normlines = takeWhile (/=".") (drop 1 r3)
  let input = unlines inplines
  let norm = unlines normlines
  let shcmd = trimr $ takeDirectory pandocpath </> cmd
  return $ runTest ("#" ++ show num) shcmd input norm

extractCommandTest :: FilePath -> Test
extractCommandTest fp = buildTest $ do
  pandocpath <- findPandoc
  contents <- UTF8.readFile ("command" </> fp)
  Pandoc _ blocks <- runIOorExplode (readMarkdown
                        def{ readerExtensions = pandocExtensions } contents)
  let codeblocks = map extractCode $ filter isCodeBlock $ blocks
  cases <- mapM (runCommandTest pandocpath) $ zip [1..] codeblocks
  return $ testGroup fp cases