[commit: ghc] master: Implement build rules for testsuite/timeout (#499) (48b81a3)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/48b81a3a523468416d07874fdaacbe597c895247/ghc

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

commit 48b81a3a523468416d07874fdaacbe597c895247
Author: Tao He <sighingnow at gmail.com>
Date:   Tue Jun 19 00:07:11 2018 +0800

    Implement build rules for testsuite/timeout (#499)


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

48b81a3a523468416d07874fdaacbe597c895247
 src/GHC.hs          |  3 ++-
 src/GHC/Packages.hs |  4 +++-
 src/Rules/Test.hs   | 51 +++++++++++++++++++++++++--------------------------
 3 files changed, 30 insertions(+), 28 deletions(-)

diff --git a/src/GHC.hs b/src/GHC.hs
index 5ee56fc..f115829 100644
--- a/src/GHC.hs
+++ b/src/GHC.hs
@@ -109,7 +109,8 @@ testsuitePackages = return [ checkApiAnnotations
                            , checkPpr
                            , ghcPkg
                            , parallel
-                           , hp2ps              ]
+                           , hp2ps
+                           , timeout         ]
 
 -- | Given a 'Context', compute the name of the program that is built in it
 -- assuming that the corresponding package's type is 'Program'. For example, GHC
diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs
index c9c6f2b..cb005ce 100644
--- a/src/GHC/Packages.hs
+++ b/src/GHC/Packages.hs
@@ -17,7 +17,8 @@ ghcPackages =
     , ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps
     , hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl
     , parsec, parallel, pretty, process, rts, runGhc, stm, templateHaskell
-    , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml ]
+    , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml
+    , timeout ]
 
 -- TODO: Optimise by switching to sets of packages.
 isGhcPackage :: Package -> Bool
@@ -81,6 +82,7 @@ unlit               = hsUtil "unlit"
 unix                = hsLib  "unix"
 win32               = hsLib  "Win32"
 xhtml               = hsLib  "xhtml"
+timeout             = hsUtil "timeout"         `setPath` "testsuite/timeout"
 
 -- | Construct a Haskell library package, e.g. @array at .
 hsLib :: PackageName -> Package
diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs
index faa79cb..4b408c0 100644
--- a/src/Rules/Test.hs
+++ b/src/Rules/Test.hs
@@ -3,6 +3,7 @@ module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
 import Base
 import Expression
 import GHC
+import GHC.Packages (timeout)
 import Oracles.Flag
 import Oracles.Setting
 import Settings
@@ -14,25 +15,6 @@ import System.Environment
 -- TODO: clean up after testing
 testRules :: Rules ()
 testRules = do
-    root <- buildRootRules
-
-    root -/- timeoutPyPath ~> do
-        copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPyPath)
-
-    -- TODO windows is still not supported.
-    --
-    -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
-    root -/- timeoutProgPath ~> do
-        python <- builderPath Python
-        need [root -/- timeoutPyPath]
-        let script = unlines
-                [ "#!/usr/bin/env sh"
-                , "exec " ++ python ++ " $0.py \"$@\""
-                ]
-        liftIO $ do
-            writeFile (root -/- timeoutProgPath) script
-        makeExecutable (root -/- timeoutProgPath)
-
     "validate" ~> do
         needTestBuilders
         build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
@@ -40,9 +22,6 @@ testRules = do
     "test" ~> do
         needTestBuilders
 
-        -- Prepare the timeout program.
-        need [ root -/- timeoutProgPath ]
-
         -- TODO This approach doesn't work.
         -- Set environment variables for test's Makefile.
         env <- sequence
@@ -78,6 +57,28 @@ needTestsuiteBuilders = do
       | isLibrary pkg = pkgConfFile (vanillaContext stage pkg)
       | otherwise = programPath =<< programContext stage pkg
 
+-- | Build the timeout program.
+-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
+timeoutProgBuilder :: Action ()
+timeoutProgBuilder = do
+    root    <- buildRoot
+    windows <- windowsHost
+    if windows
+        then do
+            prog <- programPath =<< programContext Stage1 timeout
+            need [ prog ]
+            copyFile prog (root -/- timeoutProgPath)
+        else do
+            python <- builderPath Python
+            copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py")
+            let script = unlines
+                    [ "#!/usr/bin/env sh"
+                    , "exec " ++ python ++ " $0.py \"$@\""
+                    ]
+            liftIO $ do
+                writeFile (root -/- timeoutProgPath) script
+            makeExecutable (root -/- timeoutProgPath)
+
 needTestBuilders :: Action ()
 needTestBuilders = do
     needBuilder $ Ghc CompileHs Stage2
@@ -85,6 +86,7 @@ needTestBuilders = do
     needBuilder Hpc
     needBuilder (Hsc2Hs Stage1)
     needTestsuiteBuilders
+    timeoutProgBuilder
 
 -- | Extra flags to send to the Haskell compiler to run tests.
 runTestGhcFlags :: Action String
@@ -116,8 +118,5 @@ runTestGhcFlags = do
         , pure "-dno-debug-output"
         ]
 
-timeoutPyPath :: FilePath
-timeoutPyPath = "test/bin/timeout.py"
-
 timeoutProgPath :: FilePath
-timeoutProgPath = "test/bin/timeout" <.> exe
+timeoutProgPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe