Tue Nov 28 11:37:00 UTC 2017

Repository : ssh://git@git.haskell.org/haddock

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/1377659f2fc98db024e436ffc4c59b5e8be31c7a

>---------------------------------------------------------------

commit 1377659f2fc98db024e436ffc4c59b5e8be31c7a
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Sat Aug 1 18:57:05 2015 +0200

    Add support for executing Haddock process in test runner.


>---------------------------------------------------------------

1377659f2fc98db024e436ffc4c59b5e8be31c7a
 html-test/run.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

diff --git a/html-test/run.hs b/html-test/run.hs
index a3887df..91e692a 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -13,6 +13,7 @@ import System.Environment
 import System.Exit
 import System.FilePath
 import System.IO
+import System.Process
 
 
 baseDir, rootDir :: FilePath
@@ -24,6 +25,9 @@ srcDir = baseDir </> "src"
 refDir = baseDir </> "ref"
 outDir = baseDir </> "out"
 
+resDir :: FilePath
+resDir = rootDir </> "resources"
+
 
 data Config = Config
     { cfgHaddockPath :: FilePath
@@ -34,6 +38,21 @@ data Config = Config
 main :: IO ()
 main = do
     Config { .. } <- parseArgs =<< getArgs
+
+    env <- Just . (:) ("haddock_datadir", resDir) <$> getEnvironment
+
+    handle <- runProcess' cfgHaddockPath $ processConfig
+        { pcEnv = env
+        , pcArgs = ["--version"]
+        }
+    waitForSuccess "Failed to run `haddock --version`" handle
+
+    handle <- runProcess' cfgHaddockPath $ processConfig
+        { pcEnv = env
+        , pcArgs = ["--ghc-version"]
+        }
+    waitForSuccess "Failed to run `haddock --ghc-version`" handle
+
     putStrLn $ "Files to test: " ++ show cfgFiles
 
 
@@ -92,3 +111,37 @@ haddockPath flags = case mlast [ path | FlagHaddockPath path <- flags ] of
 
 mlast :: [a] -> Maybe a
 mlast = listToMaybe . reverse
+
+
+data ProcessConfig = ProcessConfig
+    { pcArgs :: [String]
+    , pcWorkDir :: Maybe FilePath
+    , pcEnv :: Maybe [(String, String)]
+    , pcStdIn :: Maybe Handle
+    , pcStdOut :: Maybe Handle
+    , pcStdErr :: Maybe Handle
+    }
+
+
+processConfig :: ProcessConfig
+processConfig = ProcessConfig
+    { pcArgs = []
+    , pcWorkDir = Nothing
+    , pcEnv = Nothing
+    , pcStdIn = Nothing
+    , pcStdOut = Nothing
+    , pcStdErr = Nothing
+    }
+
+
+runProcess' :: FilePath -> ProcessConfig -> IO ProcessHandle
+runProcess' path (ProcessConfig { .. }) = runProcess
+    path pcArgs pcWorkDir pcEnv pcStdIn pcStdOut pcStdErr
+
+
+waitForSuccess :: String -> ProcessHandle -> IO ()
+waitForSuccess msg handle = do
+    result <- waitForProcess handle
+    unless (result == ExitSuccess) $ do
+        hPutStrLn stderr $ msg
+        exitFailure

