git.iko.soy/typeable/pandoc
on c841bcf help sign in
typeable/pandoc/test/Tests/Command.hs
141 lines 5.5 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{- |
3 Module : Tests.Command
4 Copyright : © 2006-2021 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, intercalate)
21import Data.Maybe (catMaybes)
22import System.Directory
23import qualified System.Environment as Env
24import System.Exit
25import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))
26import System.IO (hPutStr, stderr)
27import System.IO.Unsafe (unsafePerformIO)
28import System.Process
29import Test.Tasty
30import Test.Tasty.HUnit
31import Test.Tasty.Golden.Advanced (goldenTest)
32import Tests.Helpers
33import Text.Pandoc
34import qualified Text.Pandoc.UTF8 as UTF8
36-- | Run a test with and return output.
37execTest :: FilePath -- ^ Path to pandoc
38 -> String -- ^ Shell command
39 -> String -- ^ Input text
40 -> IO (ExitCode, String) -- ^ Exit code and actual output
41execTest pandocpath cmd inp = do
42 mldpath <- Env.lookupEnv "LD_LIBRARY_PATH"
43 mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH"
44 let findDynlibDir [] = Nothing
45 findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
46 findDynlibDir (_:xs) = findDynlibDir xs
47 let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
48 takeDirectory $ takeWhile (/=' ') cmd)
49 let dynlibEnv = [("DYLD_LIBRARY_PATH",
50 intercalate ":" $ catMaybes [mbDynlibDir, mdyldpath])
51 ,("LD_LIBRARY_PATH",
52 intercalate ":" $ catMaybes [mbDynlibDir, mldpath])]
53 let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),
54 ("LANG","en_US.UTF-8"),
55 ("HOME", "./"),
56 ("pandoc_datadir", "..")]
57 let pr = (shell cmd){ env = Just env' }
58 (ec, out', err') <- readCreateProcessWithExitCode pr inp
59 -- filter \r so the tests will work on Windows machines
60 let out = filter (/= '\r') $ err' ++ out'
61 case ec of
62 ExitFailure _ -> hPutStr stderr err'
63 ExitSuccess -> return ()
64 return (ec, out)
66-- | Run a test, return True if test passed.
67runTest :: String -- ^ Title of test
68 -> FilePath -- ^ Path to pandoc
69 -> String -- ^ Shell command
70 -> String -- ^ Input text
71 -> String -- ^ Expected output
72 -> TestTree
73runTest testname pandocpath cmd inp norm = testCase testname $ do
74 (ec, out) <- execTest pandocpath cmd inp
75 result <- if ec == ExitSuccess
76 then
77 if out == norm
78 then return TestPassed
79 else return
80 $ TestFailed cmd "expected"
81 $ getDiff (lines out) (lines norm)
82 else return $ TestError ec
83 assertBool (show result) (result == TestPassed)
85tests :: FilePath -> TestTree
86{-# NOINLINE tests #-}
87tests pandocPath = unsafePerformIO $ do
88 files <- filter (".md" `isSuffixOf`) <$>
89 getDirectoryContents "command"
90 let cmds = map (extractCommandTest pandocPath) files
91 return $ testGroup "Command:" cmds
93isCodeBlock :: Block -> Bool
94isCodeBlock (CodeBlock _ _) = True
95isCodeBlock _ = False
97extractCode :: Block -> String
98extractCode (CodeBlock _ code) = T.unpack code
99extractCode _ = ""
101dropPercent :: String -> String
102dropPercent ('%':xs) = dropWhile (== ' ') xs
103dropPercent xs = xs
105runCommandTest :: FilePath -> FilePath -> Int -> String -> TestTree
106runCommandTest pandocpath fp num code =
107 goldenTest testname getExpected getActual compareValues updateGolden
108 where
109 testname = "#" <> show num
110 codelines = lines code
111 (continuations, r1) = span ("\\" `isSuffixOf`) codelines
112 cmd = dropPercent (unwords (map init continuations ++ take 1 r1))
113 r2 = drop 1 r1
114 (inplines, r3) = break (=="^D") r2
115 normlines = takeWhile (/=".") (drop 1 r3)
116 input = unlines inplines
117 norm = unlines normlines
118 getExpected = return norm
119 getActual = snd <$> execTest pandocpath cmd input
120 compareValues expected actual
121 | actual == expected = return Nothing
122 | otherwise = return $ Just $ "--- test/command/" ++ fp ++ "\n+++ " ++
123 cmd ++ "\n" ++ showDiff (1,1)
124 (getDiff (lines actual) (lines expected))
125 updateGolden newnorm = do
126 let fp' = "command" </> fp
127 raw <- UTF8.readFile fp'
128 let cmdline = "% " <> cmd
129 let x = cmdline <> "\n" <> input <> "^D\n" <> norm
130 let y = cmdline <> "\n" <> input <> "^D\n" <> newnorm
131 let updated = T.unpack $ T.replace (T.pack x) (T.pack y) (T.pack raw)
132 UTF8.writeFile fp' updated
134extractCommandTest :: FilePath -> FilePath -> TestTree
135extractCommandTest pandocpath fp = unsafePerformIO $ do
136 contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
137 Pandoc _ blocks <- runIOorExplode (readMarkdown
138 def{ readerExtensions = pandocExtensions } contents)
139 let codeblocks = map extractCode $ filter isCodeBlock blocks
140 let cases = zipWith (runCommandTest pandocpath fp) [1..] codeblocks
141 return $ testGroup fp cases