git.iko.soy/typeable/pandoc
on 75dc013 help sign in
typeable/pandoc/test/Tests/Command.hs
108 lines 4.2 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{- |
3 Module : Tests.Command
4 Copyright : © 2006-2019 John MacFarlane
5 License : GNU GPL, version 2 or above
7 Maintainer : John MacFarlane <jgm@berkeley@edu>
8 Stability : alpha
9 Portability : portable
11Run commands, and test results, defined in markdown files.
12-}
13module Tests.Command (findPandoc, runTest, tests)
14where
16import Prelude
17import Data.Algorithm.Diff
18import qualified Data.ByteString as BS
19import qualified Data.Text as T
20import Data.List (isSuffixOf)
21import Prelude hiding (readFile)
22import System.Directory
23import System.Exit
24import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))
25import System.IO (hPutStr, stderr)
26import System.IO.Unsafe (unsafePerformIO)
27import System.Process
28import Test.Tasty
29import Test.Tasty.HUnit
30import Tests.Helpers
31import Text.Pandoc
32import qualified Text.Pandoc.UTF8 as UTF8
34-- | Run a test with normalize function, return True if test passed.
35runTest :: String -- ^ Title of test
36 -> FilePath -- ^ Path to pandoc
37 -> String -- ^ Shell command
38 -> String -- ^ Input text
39 -> String -- ^ Expected output
40 -> TestTree
41runTest testname pandocpath cmd inp norm = testCase testname $ do
42 let findDynlibDir [] = Nothing
43 findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
44 findDynlibDir (_:xs) = findDynlibDir xs
45 let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
46 takeDirectory $ takeWhile (/=' ') cmd)
47 let dynlibEnv = case mbDynlibDir of
48 Nothing -> []
49 Just d -> [("DYLD_LIBRARY_PATH", d),
50 ("LD_LIBRARY_PATH", d)]
51 let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"),("pandoc_datadir", "..")]
52 let pr = (shell cmd){ env = Just env' }
53 (ec, out', err') <- readCreateProcessWithExitCode pr inp
54 -- filter \r so the tests will work on Windows machines
55 let out = filter (/= '\r') $ err' ++ out'
56 result <- if ec == ExitSuccess
57 then
58 if out == norm
59 then return TestPassed
60 else return
61 $ TestFailed cmd "expected"
62 $ getDiff (lines out) (lines norm)
63 else do
64 hPutStr stderr err'
65 return $ TestError ec
66 assertBool (show result) (result == TestPassed)
68tests :: FilePath -> TestTree
69{-# NOINLINE tests #-}
70tests pandocPath = unsafePerformIO $ do
71 files <- filter (".md" `isSuffixOf`) <$>
72 getDirectoryContents "command"
73 let cmds = map (extractCommandTest pandocPath) files
74 return $ testGroup "Command:" cmds
76isCodeBlock :: Block -> Bool
77isCodeBlock (CodeBlock _ _) = True
78isCodeBlock _ = False
80extractCode :: Block -> String
81extractCode (CodeBlock _ code) = T.unpack code
82extractCode _ = ""
84dropPercent :: String -> String
85dropPercent ('%':xs) = dropWhile (== ' ') xs
86dropPercent xs = xs
88runCommandTest :: FilePath -> (Int, String) -> TestTree
89runCommandTest pandocpath (num, code) =
90 let codelines = lines code
91 (continuations, r1) = span ("\\" `isSuffixOf`) codelines
92 (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
93 drop 1 r1)
94 (inplines, r3) = break (=="^D") r2
95 normlines = takeWhile (/=".") (drop 1 r3)
96 input = unlines inplines
97 norm = unlines normlines
98 shcmd = cmd -- trimr $ takeDirectory pandocpath </> cmd
99 in runTest ("#" ++ show num) pandocpath shcmd input norm
101extractCommandTest :: FilePath -> FilePath -> TestTree
102extractCommandTest pandocpath fp = unsafePerformIO $ do
103 contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
104 Pandoc _ blocks <- runIOorExplode (readMarkdown
105 def{ readerExtensions = pandocExtensions } contents)
106 let codeblocks = map extractCode $ filter isCodeBlock blocks
107 let cases = map (runCommandTest pandocpath) $ zip [1..] codeblocks
108 return $ testGroup fp cases