Make runtests.hs strip links before diffing

Generates easier to read diffs when tests fail. The content of the links
is not important anyway since it is not taken into account by the tests.

1 files changed, 9 insertions, 4 deletions

diff --git a/tests/runtests.hs b/tests/runtests.hs
index 45c73ee2..9acc3c38 100644
--- a/tests/runtests.hs
+++ b/tests/runtests.hs
@@ -20,9 +20,8 @@ main = do
 
 
 haddockEq file1 file2 = stripLinks file1 == stripLinks file2
-  where
-    stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"
 
+stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"
 
 programOnPath p = do
   result <- findProgramOnPath silent p
@@ -42,10 +41,16 @@ check modules strict = do
         if not $ haddockEq out ref
           then do
             putStrLn $ "Output for " ++ mod ++ " has changed! Exiting with diff:"
+            let ref' = stripLinks ref
+                out' = stripLinks out
+            let reffile' = "output" </> takeFileName reffile ++ ".nolinks"
+                outfile' = "output" </> takeFileName outfile ++ ".nolinks"
+            writeFile reffile' ref'
+            writeFile outfile' out'
             b <- programOnPath "colordiff"
             if b
-              then system $ "colordiff " ++ reffile ++ " " ++ outfile
-              else system $ "diff " ++ reffile ++ " " ++ outfile
+              then system $ "colordiff " ++ reffile' ++ " " ++ outfile'
+              else system $ "diff " ++ reffile' ++ " " ++ outfile'
             if strict then exitFailure else return ()
           else do
             putStrLn $ "Pass: " ++ mod