aboutsummaryrefslogtreecommitdiff
path: root/hypsrc-test
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-07-01 00:47:32 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-07-01 00:47:32 +0200
commit395a9c3941f8b8891cffa5c17e1f6ae414edaa79 (patch)
tree30c6bad02b7fcf68701e7672503eeff7d335c473 /hypsrc-test
parent40d0a050c81ff21949fc7eeede4e0dbb3b1d7c98 (diff)
Make hyperlinker test runner strip local links from generated source.
Diffstat (limited to 'hypsrc-test')
-rw-r--r--hypsrc-test/Utils.hs26
-rwxr-xr-xhypsrc-test/run.hs37
2 files changed, 53 insertions, 10 deletions
diff --git a/hypsrc-test/Utils.hs b/hypsrc-test/Utils.hs
new file mode 100644
index 00000000..cf3e94ea
--- /dev/null
+++ b/hypsrc-test/Utils.hs
@@ -0,0 +1,26 @@
+module Utils
+ ( stripLocalAnchors
+ , stripLocalLinks
+ , stripLocalReferences
+ ) where
+
+
+import Data.List
+
+
+replaceBetween :: Eq a => [a] -> a -> [a] -> [a] -> [a]
+replaceBetween _ _ _ [] = []
+replaceBetween pref end val html@(x:xs') = case stripPrefix pref html of
+ Just strip -> pref ++ val ++ (replaceBetween' . dropWhile (/= end)) strip
+ Nothing -> x:(replaceBetween' xs')
+ where
+ replaceBetween' = replaceBetween pref end val
+
+stripLocalAnchors :: String -> String
+stripLocalAnchors = replaceBetween "<a name=\"local-" '\"' "0"
+
+stripLocalLinks :: String -> String
+stripLocalLinks = replaceBetween "<a href=\"#local-" '\"' "0"
+
+stripLocalReferences :: String -> String
+stripLocalReferences = stripLocalLinks . stripLocalAnchors
diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index e9a38c0c..5b6b6548 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -18,6 +18,8 @@ import System.Process
import Distribution.Verbosity
import Distribution.Simple.Utils hiding (die)
+import Utils
+
baseDir, rootDir :: FilePath
baseDir = takeDirectory __FILE__
@@ -64,14 +66,9 @@ check strict mdl = do
hasReference <- doesFileExist refFile
if hasReference
then do
- out <- readFile outFile
ref <- readFile refFile
- if out == ref
- then putStrLn $ "Pass: " ++ mdl
- else do
- putStrLn $ "Fail: " ++ mdl
- diff refFile outFile
- when strict $ die "Aborting further tests."
+ out <- readFile outFile
+ compareOutput strict mdl ref out
else do
putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
where
@@ -79,13 +76,33 @@ check strict mdl = do
outFile = outDir' </> takeBaseName mdl ++ ".html"
-diff :: FilePath -> FilePath -> IO ()
-diff fileA fileB = do
+compareOutput :: Bool -> FilePath -> String -> String -> IO ()
+compareOutput strict mdl ref out = do
+ if ref' == out'
+ then putStrLn $ "Pass: " ++ mdl
+ else do
+ putStrLn $ "Fail: " ++ mdl
+ diff mdl ref' out'
+ when strict $ die "Aborting further tests."
+ where
+ ref' = stripLocalReferences ref
+ out' = stripLocalReferences out
+
+
+diff :: FilePath -> String -> String -> IO ()
+diff mdl ref out = do
colorDiffPath <- findProgramLocation silent "colordiff"
let cmd = fromMaybe "diff" colorDiffPath
- result <- system $ cmd ++ " " ++ fileA ++ " " ++ fileB
+ writeFile refFile ref
+ writeFile outFile out
+
+ result <- system $ cmd ++ " " ++ refFile ++ " " ++ outFile
unless (result == ExitSuccess) $ die "Failed to run `diff` command."
+ where
+ refFile = outDir </> takeFileName mdl </> ".ref.nolinks"
+ outFile = outDir </> takeFileName mdl </> ".nolinks"
+
getAllSrcModules :: IO [FilePath]