1 files changed, 155 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/tests/RunTests.hs b/third_party/bazel/rules_haskell/tests/RunTests.hs
new file mode 100644
index 000000000000..b6218bbcefc2
--- /dev/null
+++ b/third_party/bazel/rules_haskell/tests/RunTests.hs
@@ -0,0 +1,155 @@
+{-# OPTIONS -Wall #-}
+
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+import Data.Foldable (for_)
+import Data.List (isInfixOf, sort)
+import System.Exit (ExitCode(..))
+
+import qualified System.Process as Process
+import Test.Hspec.Core.Spec (SpecM)
+import Test.Hspec (hspec, it, describe, runIO, shouldSatisfy, expectationFailure)
+
+main :: IO ()
+main = hspec $ do
+  it "bazel lint" $ do
+    assertSuccess (bazel ["run", "//:buildifier"])
+
+  it "bazel test" $ do
+    assertSuccess (bazel ["test", "//...", "--build_tests_only"])
+
+  it "haddock links" $ do
+    -- Test haddock links
+    -- All haddock tests are stored inside //tests/haddock
+    -- Temporaries files appears inside /doc-.... outputs and are ignored
+
+    -- the copy / chmod is here to workaround the fact that
+    -- linkchecker is dropping privileges to "nobody" user if called
+    -- from root, which is the case on CI.
+    assertSuccess (safeShell
+      [ "bazel build --config=ci //tests/haddock/..."
+      , "pwd=$(pwd)"
+      , "cd $(mktemp -d)"
+      , "cp -r $pwd/bazel-ci-bin/tests/haddock ."
+      , "chmod -R o+r ."
+      , "linkchecker . --ignore-url=/doc-"
+      ])
+
+  it "bazel test prof" $ do
+    assertSuccess (bazel ["test", "-c", "dbg", "//...", "--build_tests_only"])
+
+  describe "repl" $ do
+    it "for libraries" $ do
+      assertSuccess (bazel ["run", "//tests/repl-targets:hs-lib@repl", "--", "-ignore-dot-ghci", "-e", "show (foo 10) ++ bar ++ baz ++ gen"])
+      assertSuccess (bazel ["run", "//tests/repl-targets:hs-lib-bad@repl", "--", "-ignore-dot-ghci", "-e", "1 + 2"])
+
+    it "for binaries" $ do
+      assertSuccess (bazel ["run", "//tests/repl-targets:hs-bin@repl", "--", "-ignore-dot-ghci", "-e", ":main"])
+
+      assertSuccess (bazel ["run", "//tests/binary-indirect-cbits:binary-indirect-cbits@repl", "--", "-ignore-dot-ghci", "-e", ":main"])
+
+    -- Test `compiler_flags` from toolchain and rule for REPL
+    it "compiler flags" $ do
+      assertSuccess (bazel ["run", "//tests/repl-flags:compiler_flags@repl", "--", "-ignore-dot-ghci", "-e", ":main"])
+
+    -- Test `repl_ghci_args` from toolchain and rule for REPL
+    it "repl flags" $ do
+      assertSuccess (bazel ["run", "//tests/repl-flags:repl_flags@repl", "--", "-ignore-dot-ghci", "-e", "foo"])
+
+  describe "multi_repl" $ do
+    it "loads transitive library dependencies" $ do
+      let p' (stdout, _stderr) = lines stdout == ["tests/multi_repl/bc/src/BC/C.hs"]
+      outputSatisfy p' (bazel ["run", "//tests/multi_repl:c_only_repl", "--", "-ignore-dot-ghci", "-e", ":show targets"])
+    it "loads transitive source dependencies" $ do
+      let p' (stdout, _stderr) = sort (lines stdout) == ["tests/multi_repl/a/src/A/A.hs","tests/multi_repl/bc/src/BC/B.hs","tests/multi_repl/bc/src/BC/C.hs"]
+      outputSatisfy p' (bazel ["run", "//tests/multi_repl:c_multi_repl", "--", "-ignore-dot-ghci", "-e", ":show targets"])
+
+  it "startup script" $ do
+    assertSuccess (safeShell ["./tests/run-start-script.sh"])
+
+  describe "failures" $ do
+    all_failure_tests <- bazelQuery "kind(rule, //tests/failures/...) intersect attr('tags', 'manual', //tests/failures/...)"
+
+    for_ all_failure_tests $ \test -> do
+      it test $ do
+        assertFailure (bazel ["build", "test"])
+
+  -- Test that the repl still works if we shadow some Prelude functions
+  it "repl name shadowing" $ do
+    let p (stdout, stderr) = not $ any ("error" `isInfixOf`) [stdout, stderr]
+    outputSatisfy p (bazel ["run", "//tests/repl-name-conflicts:lib@repl", "--", "-ignore-dot-ghci", "-e", "stdin"])
+
+  it "bazel test examples" $ do
+    assertSuccess (bazel ["test", "@io_tweag_rules_haskell_examples//..."])
+
+  it "bazel test tutorial" $ do
+    assertSuccess (bazel ["test", "@io_tweag_rules_haskell_tutorial//..."])
+
+-- * Bazel commands
+
+-- | Returns a bazel command line suitable for CI
+-- This should be called with the action as first item of the list. e.g 'bazel ["build", "//..."]'.
+bazel :: [String] -> Process.CreateProcess
+-- Note: --config=ci is intercalated between the action and the list
+-- of arguments. It should appears after the action, but before any
+-- @--@ following argument.
+bazel (command:args) = Process.proc "bazel" (command:"--config=ci":args)
+bazel [] = Process.proc "bazel" []
+
+-- | Runs a bazel query and return the list of matching targets
+bazelQuery :: String -> SpecM a [String]
+bazelQuery q = lines <$> runIO (Process.readProcess "bazel" ["query", q] "")
+
+-- * Action helpers
+
+-- | Ensure that @(stdout, stderr)@ of the command satisfies a predicate
+outputSatisfy
+  :: ((String, String) -> Bool)
+  -> Process.CreateProcess
+  -> IO ()
+outputSatisfy predicate cmd = do
+  (exitCode, stdout, stderr) <- Process.readCreateProcessWithExitCode cmd ""
+
+  case exitCode of
+    ExitSuccess -> (stdout, stderr) `shouldSatisfy` predicate
+    ExitFailure _ -> expectationFailure (formatOutput exitCode stdout stderr)
+
+-- | The command must success
+assertSuccess :: Process.CreateProcess -> IO ()
+assertSuccess = outputSatisfy (const True)
+
+-- | The command must fail
+assertFailure :: Process.CreateProcess -> IO ()
+assertFailure cmd = do
+  (exitCode, stdout, stderr) <- Process.readCreateProcessWithExitCode cmd ""
+
+  case exitCode of
+    ExitFailure _ -> pure ()
+    ExitSuccess -> expectationFailure ("Unexpected success of a failure test with output:\n" ++ formatOutput exitCode stdout stderr)
+
+-- | Execute in a sub shell the list of command
+-- This will fail if any of the command in the list fail
+safeShell :: [String] -> Process.CreateProcess
+safeShell l = Process.shell (unlines ("set -e":l))
+
+-- * Formatting helpers
+
+formatOutput :: ExitCode -> String -> String -> String
+formatOutput exitcode stdout stderr =
+  let
+    header = replicate 20 '-'
+    headerLarge = replicate 20 '='
+
+  in unlines [
+      headerLarge
+    , "Exit Code: " <> show exitcode
+    , headerLarge
+    , "Standard Output"
+    , header
+    , stdout
+    , headerLarge
+    , "Error Output"
+    , header
+    , stderr
+    , header]