git.iko.soy/typeable/pandoc
on 2.7 help sign in
typeable/pandoc/test/Tests/Command.hs
107 lines 4.1 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 Data.List (isSuffixOf)
20import Prelude hiding (readFile)
21import System.Directory
22import System.Exit
23import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))
24import System.IO (hPutStr, stderr)
25import System.IO.Unsafe (unsafePerformIO)
26import System.Process
27import Test.Tasty
28import Test.Tasty.HUnit
29import Tests.Helpers
30import Text.Pandoc
31import qualified Text.Pandoc.UTF8 as UTF8
33-- | Run a test with normalize function, return True if test passed.
34runTest :: String -- ^ Title of test
35 -> FilePath -- ^ Path to pandoc
36 -> String -- ^ Shell command
37 -> String -- ^ Input text
38 -> String -- ^ Expected output
39 -> TestTree
40runTest testname pandocpath cmd inp norm = testCase testname $ do
41 let findDynlibDir [] = Nothing
42 findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
43 findDynlibDir (_:xs) = findDynlibDir xs
44 let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
45 takeDirectory $ takeWhile (/=' ') cmd)
46 let dynlibEnv = case mbDynlibDir of
47 Nothing -> []
48 Just d -> [("DYLD_LIBRARY_PATH", d),
49 ("LD_LIBRARY_PATH", d)]
50 let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"),("pandoc_datadir", "..")]
51 let pr = (shell cmd){ env = Just env' }
52 (ec, out', err') <- readCreateProcessWithExitCode pr inp
53 -- filter \r so the tests will work on Windows machines
54 let out = filter (/= '\r') $ err' ++ out'
55 result <- if ec == ExitSuccess
56 then
57 if out == norm
58 then return TestPassed
59 else return
60 $ TestFailed cmd "expected"
61 $ getDiff (lines out) (lines norm)
62 else do
63 hPutStr stderr err'
64 return $ TestError ec
65 assertBool (show result) (result == TestPassed)
67tests :: FilePath -> TestTree
68{-# NOINLINE tests #-}
69tests pandocPath = unsafePerformIO $ do
70 files <- filter (".md" `isSuffixOf`) <$>
71 getDirectoryContents "command"
72 let cmds = map (extractCommandTest pandocPath) files
73 return $ testGroup "Command:" cmds
75isCodeBlock :: Block -> Bool
76isCodeBlock (CodeBlock _ _) = True
77isCodeBlock _ = False
79extractCode :: Block -> String
80extractCode (CodeBlock _ code) = code
81extractCode _ = ""
83dropPercent :: String -> String
84dropPercent ('%':xs) = dropWhile (== ' ') xs
85dropPercent xs = xs
87runCommandTest :: FilePath -> (Int, String) -> TestTree
88runCommandTest pandocpath (num, code) =
89 let codelines = lines code
90 (continuations, r1) = span ("\\" `isSuffixOf`) codelines
91 (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
92 drop 1 r1)
93 (inplines, r3) = break (=="^D") r2
94 normlines = takeWhile (/=".") (drop 1 r3)
95 input = unlines inplines
96 norm = unlines normlines
97 shcmd = cmd -- trimr $ takeDirectory pandocpath </> cmd
98 in runTest ("#" ++ show num) pandocpath shcmd input norm
100extractCommandTest :: FilePath -> FilePath -> TestTree
101extractCommandTest pandocpath fp = unsafePerformIO $ do
102 contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
103 Pandoc _ blocks <- runIOorExplode (readMarkdown
104 def{ readerExtensions = pandocExtensions } contents)
105 let codeblocks = map extractCode $ filter isCodeBlock blocks
106 let cases = map (runCommandTest pandocpath) $ zip [1..] codeblocks
107 return $ testGroup fp cases