git.iko.soy/typeable/pandoc
on 76a4e71 help sign in
typeable/pandoc/test/Tests/Command.hs
133 lines 4.9 kB history raw
1{- |
2 Module : Tests.Command
3 Copyright : © 2006-2021 John MacFarlane
4 License : GNU GPL, version 2 or above
6 Maintainer : John MacFarlane <jgm@berkeley@edu>
7 Stability : alpha
8 Portability : portable
10Run commands, and test results, defined in markdown files.
11-}
12module Tests.Command (runTest, tests)
13where
15import Data.Algorithm.Diff
16import System.Environment (getExecutablePath)
17import qualified Data.ByteString as BS
18import qualified Data.Text as T
19import Data.List (isSuffixOf)
20import System.Directory
21import System.Exit
22import System.FilePath ((</>))
23import System.IO (hPutStr, stderr)
24import System.IO.Unsafe (unsafePerformIO)
25import System.Process
26import Test.Tasty
27import Test.Tasty.HUnit
28import Test.Tasty.Golden.Advanced (goldenTest)
29import Tests.Helpers
30import Text.Pandoc
31import qualified Text.Pandoc.UTF8 as UTF8
33-- | Run a test with and return output.
34execTest :: String -- ^ Path to test executable
35 -> String -- ^ Shell command
36 -> String -- ^ Input text
37 -> IO (ExitCode, String) -- ^ Exit code and actual output
38execTest testExePath cmd inp = do
39 env' <- setupEnvironment testExePath
40 let pr = (shell (pandocToEmulate True cmd)){ env = Just env' }
41 (ec, out', err') <- readCreateProcessWithExitCode pr inp
42 -- filter \r so the tests will work on Windows machines
43 let out = filter (/= '\r') $ err' ++ out'
44 case ec of
45 ExitFailure _ -> hPutStr stderr err'
46 ExitSuccess -> return ()
47 return (ec, out)
49pandocToEmulate :: Bool -> String -> String
50pandocToEmulate True ('p':'a':'n':'d':'o':'c':cs) =
51 "test-pandoc --emulate" ++ pandocToEmulate False cs
52pandocToEmulate False ('|':' ':'p':'a':'n':'d':'o':'c':cs) =
53 "| " ++ "test-pandoc --emulate" ++ pandocToEmulate False cs
54pandocToEmulate _ (c:cs) = c : pandocToEmulate False cs
55pandocToEmulate _ [] = []
57-- | Run a test, return True if test passed.
58runTest :: String -- ^ Path to test executable
59 -> String -- ^ Title of test
60 -> String -- ^ Shell command
61 -> String -- ^ Input text
62 -> String -- ^ Expected output
63 -> TestTree
64runTest testExePath testname cmd inp norm = testCase testname $ do
65 (ec, out) <- execTest testExePath cmd inp
66 result <- if ec == ExitSuccess
67 then
68 if out == norm
69 then return TestPassed
70 else return
71 $ TestFailed cmd "expected"
72 $ getDiff (lines out) (lines norm)
73 else return $ TestError ec
74 assertBool (show result) (result == TestPassed)
76tests :: TestTree
77{-# NOINLINE tests #-}
78tests = unsafePerformIO $ do
79 files <- filter (".md" `isSuffixOf`) <$>
80 getDirectoryContents "command"
81 testExePath <- getExecutablePath
82 let cmds = map (extractCommandTest testExePath) files
83 return $ testGroup "Command:" cmds
85isCodeBlock :: Block -> Bool
86isCodeBlock (CodeBlock _ _) = True
87isCodeBlock _ = False
89extractCode :: Block -> String
90extractCode (CodeBlock _ code) = T.unpack code
91extractCode _ = ""
93dropPercent :: String -> String
94dropPercent ('%':xs) = dropWhile (== ' ') xs
95dropPercent xs = xs
97runCommandTest :: FilePath -> FilePath -> Int -> String -> TestTree
98runCommandTest testExePath fp num code =
99 goldenTest testname getExpected getActual compareValues updateGolden
100 where
101 testname = "#" <> show num
102 codelines = lines code
103 (continuations, r1) = span ("\\" `isSuffixOf`) codelines
104 cmd = dropPercent (unwords (map init continuations ++ take 1 r1))
105 r2 = drop 1 r1
106 (inplines, r3) = break (=="^D") r2
107 normlines = takeWhile (/=".") (drop 1 r3)
108 input = unlines inplines
109 norm = unlines normlines
110 getExpected = return norm
111 getActual = snd <$> execTest testExePath cmd input
112 compareValues expected actual
113 | actual == expected = return Nothing
114 | otherwise = return $ Just $ "--- test/command/" ++ fp ++ "\n+++ " ++
115 cmd ++ "\n" ++ showDiff (1,1)
116 (getDiff (lines actual) (lines expected))
117 updateGolden newnorm = do
118 let fp' = "command" </> fp
119 raw <- UTF8.readFile fp'
120 let cmdline = "% " <> cmd
121 let x = cmdline <> "\n" <> input <> "^D\n" <> norm
122 let y = cmdline <> "\n" <> input <> "^D\n" <> newnorm
123 let updated = T.replace (T.pack x) (T.pack y) raw
124 UTF8.writeFile fp' updated
126extractCommandTest :: FilePath -> FilePath -> TestTree
127extractCommandTest testExePath fp = unsafePerformIO $ do
128 contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
129 Pandoc _ blocks <- runIOorExplode (readMarkdown
130 def{ readerExtensions = pandocExtensions } contents)
131 let codeblocks = map extractCode $ filter isCodeBlock blocks
132 let cases = zipWith (runCommandTest testExePath fp) [1..] codeblocks
133 return $ testGroup fp cases