diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2018-04-24 10:49:04 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2018-04-24 10:49:04 -0700 |
commit | a080dde1efb823e6e25e6ba0ead2afeb76012e43 (patch) | |
tree | 6165e39a24544d1387a201790541147e0f7478ab /test/Tests/Command.hs | |
parent | a9ae23fa15d769ab9b05f483c8511e96cc684403 (diff) | |
parent | de5ee82ed0e287ada3a5b272d8365a04fe8e9f95 (diff) |
Merge tag 'upstream/2.1.2_dfsg'
Upstream version 2.1.2~dfsg
# gpg: Signature made Tue 24 Apr 2018 10:48:48 AM MST
# gpg: using RSA key 9B917007AE030E36E4FC248B695B7AE4BF066240
# gpg: issuer "spwhitton@spwhitton.name"
# gpg: Good signature from "Sean Whitton <spwhitton@spwhitton.name>" [ultimate]
# Primary key fingerprint: 8DC2 487E 51AB DD90 B5C4 753F 0F56 D055 3B6D 411B
# Subkey fingerprint: 9B91 7007 AE03 0E36 E4FC 248B 695B 7AE4 BF06 6240
Diffstat (limited to 'test/Tests/Command.hs')
-rw-r--r-- | test/Tests/Command.hs | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/test/Tests/Command.hs b/test/Tests/Command.hs new file mode 100644 index 000000000..de83d0639 --- /dev/null +++ b/test/Tests/Command.hs @@ -0,0 +1,95 @@ +module Tests.Command (findPandoc, runTest, tests) +where + +import Data.Algorithm.Diff +import qualified Data.ByteString as BS +import Data.List (isSuffixOf) +import Prelude hiding (readFile) +import System.Directory +import System.Exit +import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>)) +import System.IO (hPutStr, stderr) +import System.IO.Unsafe (unsafePerformIO) +import System.Process +import Test.Tasty +import Test.Tasty.HUnit +import Tests.Helpers +import Text.Pandoc +import qualified Text.Pandoc.UTF8 as UTF8 + +-- | Run a test with normalize function, return True if test passed. +runTest :: String -- ^ Title of test + -> FilePath -- ^ Path to pandoc + -> String -- ^ Shell command + -> String -- ^ Input text + -> String -- ^ Expected output + -> TestTree +runTest testname pandocpath cmd inp norm = testCase testname $ do + let findDynlibDir [] = Nothing + findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build" + findDynlibDir (_:xs) = findDynlibDir xs + let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $ + takeDirectory $ takeWhile (/=' ') cmd) + let dynlibEnv = case mbDynlibDir of + Nothing -> [] + Just d -> [("DYLD_LIBRARY_PATH", d), + ("LD_LIBRARY_PATH", d)] + let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"),("pandoc_datadir", "..")] + let pr = (shell cmd){ env = Just env' } + (ec, out', err') <- readCreateProcessWithExitCode pr inp + -- filter \r so the tests will work on Windows machines + let out = filter (/= '\r') $ err' ++ out' + result <- if ec == ExitSuccess + then + if out == norm + then return TestPassed + else return + $ TestFailed cmd "expected" + $ getDiff (lines out) (lines norm) + else do + hPutStr stderr err' + return $ TestError ec + assertBool (show result) (result == TestPassed) + +tests :: TestTree +{-# NOINLINE tests #-} +tests = unsafePerformIO $ do + pandocpath <- findPandoc + files <- filter (".md" `isSuffixOf`) <$> + getDirectoryContents "command" + let cmds = map (extractCommandTest pandocpath) files + return $ testGroup "Command:" cmds + +isCodeBlock :: Block -> Bool +isCodeBlock (CodeBlock _ _) = True +isCodeBlock _ = False + +extractCode :: Block -> String +extractCode (CodeBlock _ code) = code +extractCode _ = "" + +dropPercent :: String -> String +dropPercent ('%':xs) = dropWhile (== ' ') xs +dropPercent xs = xs + +runCommandTest :: FilePath -> (Int, String) -> TestTree +runCommandTest pandocpath (num, code) = + let codelines = lines code + (continuations, r1) = span ("\\" `isSuffixOf`) codelines + (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)), + drop 1 r1) + (inplines, r3) = break (=="^D") r2 + normlines = takeWhile (/=".") (drop 1 r3) + input = unlines inplines + norm = unlines normlines + shcmd = cmd -- trimr $ takeDirectory pandocpath </> cmd + in runTest ("#" ++ show num) pandocpath shcmd input norm + +extractCommandTest :: FilePath -> FilePath -> TestTree +extractCommandTest pandocpath fp = unsafePerformIO $ do + contents <- UTF8.toText <$> BS.readFile ("command" </> fp) + Pandoc _ blocks <- runIOorExplode (readMarkdown + def{ readerExtensions = pandocExtensions } contents) + let codeblocks = map extractCode $ filter isCodeBlock blocks + let cases = map (runCommandTest pandocpath) $ zip [1..] codeblocks + return $ testGroup fp cases |