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
|
{-# LANGUAGE NoImplicitPrelude #-}
{- |
Module : Tests.Command
Copyright : © 2006-2020 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley@edu>
Stability : alpha
Portability : portable
Run commands, and test results, defined in markdown files.
-}
module Tests.Command (findPandoc, runTest, tests)
where
import Prelude
import Data.Algorithm.Diff
import qualified Data.ByteString as BS
import qualified Data.Text as T
import Data.List (isSuffixOf)
import System.Directory
import System.Exit
import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))
import System.IO (hPutStr, stderr)
import System.IO.Unsafe (unsafePerformIO)
import System.Process
import Test.Tasty
import Test.Tasty.HUnit
import Tests.Helpers
import Text.Pandoc
import qualified Text.Pandoc.UTF8 as UTF8
-- | Run a test with normalize function, return True if test passed.
runTest :: String -- ^ Title of test
-> FilePath -- ^ Path to pandoc
-> String -- ^ Shell command
-> String -- ^ Input text
-> String -- ^ Expected output
-> TestTree
runTest testname pandocpath cmd inp norm = testCase testname $ do
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 ++ [("PATH",takeDirectory pandocpath),("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"),("pandoc_datadir", "..")]
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') $ err' ++ out'
result <- if ec == ExitSuccess
then
if out == norm
then return TestPassed
else return
$ TestFailed cmd "expected"
$ getDiff (lines out) (lines norm)
else do
hPutStr stderr err'
return $ TestError ec
assertBool (show result) (result == TestPassed)
tests :: FilePath -> TestTree
{-# NOINLINE tests #-}
tests pandocPath = unsafePerformIO $ do
files <- filter (".md" `isSuffixOf`) <$>
getDirectoryContents "command"
let cmds = map (extractCommandTest pandocPath) files
return $ testGroup "Command:" cmds
isCodeBlock :: Block -> Bool
isCodeBlock (CodeBlock _ _) = True
isCodeBlock _ = False
extractCode :: Block -> String
extractCode (CodeBlock _ code) = T.unpack code
extractCode _ = ""
dropPercent :: String -> String
dropPercent ('%':xs) = dropWhile (== ' ') xs
dropPercent xs = xs
runCommandTest :: FilePath -> Int -> String -> TestTree
runCommandTest pandocpath num code =
let codelines = lines code
(continuations, r1) = span ("\\" `isSuffixOf`) codelines
(cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
drop 1 r1)
(inplines, r3) = break (=="^D") r2
normlines = takeWhile (/=".") (drop 1 r3)
input = unlines inplines
norm = unlines normlines
shcmd = cmd -- trimr $ takeDirectory pandocpath </> cmd
in runTest ("#" ++ show num) pandocpath shcmd input norm
extractCommandTest :: FilePath -> FilePath -> TestTree
extractCommandTest pandocpath fp = unsafePerformIO $ do
contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
Pandoc _ blocks <- runIOorExplode (readMarkdown
def{ readerExtensions = pandocExtensions } contents)
let codeblocks = map extractCode $ filter isCodeBlock blocks
let cases = zipWith (runCommandTest pandocpath) [1..] codeblocks
return $ testGroup fp cases
|
