aboutsummaryrefslogtreecommitdiff
path: root/tests/html-tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests/html-tests')
-rw-r--r--tests/html-tests/README6
-rw-r--r--tests/html-tests/accept.hs30
-rw-r--r--tests/html-tests/runtests.hs49
3 files changed, 63 insertions, 22 deletions
diff --git a/tests/html-tests/README b/tests/html-tests/README
index 644d0a71..9afb10e7 100644
--- a/tests/html-tests/README
+++ b/tests/html-tests/README
@@ -9,12 +9,12 @@ To add a new test:
passes since there is no reference file to compare with.
3) To make a reference file from the output file, do
- runhaskell copy.hs <modulename>
+ runhaskell accept.hs <modulename>
Tips and tricks:
-To copy all output files into reference files, run
- runhaskell copy.hs
+To "accept" all output files (copy them to reference files), run
+ runhaskell accept.hs
You can run all tests despite failing tests, like so
cabal test --test-option=all
diff --git a/tests/html-tests/accept.hs b/tests/html-tests/accept.hs
new file mode 100644
index 00000000..fa18fe9c
--- /dev/null
+++ b/tests/html-tests/accept.hs
@@ -0,0 +1,30 @@
+import System.Cmd
+import System.Environment
+import System.FilePath
+import System.Exit
+import System.Directory
+import Data.List
+import Control.Monad
+import Text.Regex
+
+
+main = do
+ args <- getArgs
+ dir <- getCurrentDirectory
+ contents <- getDirectoryContents (dir </> "output")
+ if not $ null args
+ then
+ mapM copy [ "output" </> file | file <- contents, ".html" `isSuffixOf` file, takeBaseName file `elem` args ]
+ else
+ mapM copy [ "output" </> file | file <- contents, ".html" `isSuffixOf` file ]
+
+
+copy file = do
+ let new = "tests" </> takeFileName file <.> ".ref"
+ print file
+ print new
+ contents <- readFile file
+ writeFile new (stripLinks contents)
+
+
+stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"
diff --git a/tests/html-tests/runtests.hs b/tests/html-tests/runtests.hs
index 2f7ed2e2..48ea5214 100644
--- a/tests/html-tests/runtests.hs
+++ b/tests/html-tests/runtests.hs
@@ -1,17 +1,22 @@
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Distribution.InstalledPackageInfo
+import Distribution.Package
+import Distribution.Simple.Compiler
+import Distribution.Simple.GHC
+import Distribution.Simple.PackageIndex
+import Distribution.Simple.Program
+import Distribution.Simple.Utils
+import Distribution.Verbosity
import System.Cmd
+import System.Directory
import System.Environment
-import System.FilePath
import System.Exit
-import System.Directory
+import System.FilePath
import System.Process
-import Data.List
-import Control.Monad
import Text.Printf
import Text.Regex
-import Distribution.Simple.Utils
-import Distribution.Simple.Program
-import Distribution.Verbosity
-import Data.Maybe
packageRoot = "."
@@ -51,17 +56,23 @@ test = do
waitForProcess h2
putStrLn ""
- -- TODO: use Distribution.* to get the packages instead
- libdir <- rawSystemStdout normal haddockPath ["--print-ghc-libdir"]
- let librariesPath = ".."</>".."</>"share"</>"doc"</>"ghc"</>"html"</>"libraries"
-
- let mkDep name version =
- let path = init libdir </> librariesPath </> name ++ "-" ++ version
- in "-i " ++ path ++ "," ++ path </> name ++ ".haddock"
-
- let base = mkDep "base" "4.3.1.0"
- process = mkDep "process" "1.0.1.5"
- ghcprim = mkDep "ghc-prim" "0.2.0.0"
+ -- TODO: maybe do something more clever here using haddock.cabal
+ ghcPath <- fmap init $ rawSystemStdout normal haddockPath ["--print-ghc-path"]
+ (_, conf) <- configure normal (Just ghcPath) Nothing emptyProgramConfiguration
+ pkgIndex <- getInstalledPackages normal [GlobalPackageDB] conf
+ let safeHead xs = case xs of x : _ -> Just x; [] -> Nothing
+ let mkDep pkgName =
+ maybe (error "Couldn't find test dependencies") id $ do
+ let pkgs = lookupPackageName pkgIndex (PackageName pkgName)
+ (_, pkgs') <- safeHead pkgs
+ pkg <- safeHead pkgs'
+ ifacePath <- safeHead (haddockInterfaces pkg)
+ htmlPath <- safeHead (haddockHTMLs pkg)
+ return ("-i " ++ htmlPath ++ "," ++ ifacePath)
+
+ let base = mkDep "base"
+ process = mkDep "process"
+ ghcprim = mkDep "ghc-prim"
putStrLn "Running tests..."
handle <- runProcess haddockPath