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