hie-bios-0.21.0: tests/BiosTests.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
module Main (main) where
import Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (replicateConcurrently)
import Control.Exception (SomeException, evaluate, try)
import Control.Monad (forM, forM_, unless, when)
import Control.Monad.Extra (unlessM)
import Control.Monad.IO.Class
import Data.Foldable (for_)
import Data.List (isInfixOf, isPrefixOf, sort, tails, last)
import Data.Maybe (isJust)
import Data.Typeable
import Data.Version
import HIE.Bios
import HIE.Bios.Cradle
import HIE.Bios.Cradle.Cabal (cabalBuildDir)
import HIE.Bios.Cradle.Utils (expandGhcOptionResponseFile)
import HIE.Bios.Environment (extractUnits, resolveCacheDir)
import qualified HIE.Bios.Ghc.Gap as Gap
import HIE.Bios.Process (cacheFileIn)
import HIE.Bios.Types (CacheDir (..), LoadMode (..), TargetWithContext (..))
import System.Directory
import System.Exit (ExitCode (ExitFailure, ExitSuccess))
import System.FilePath (makeRelative, (</>))
import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout)
import System.IO.Temp
import System.Info.Extra (isWindows)
import System.Process
import Test.Tasty
import Test.Tasty.ExpectedFailure
import Test.Tasty.HUnit
import qualified Test.Tasty.Ingredients as Tasty
import qualified Test.Tasty.Options as Tasty
import qualified Test.Tasty.Runners as Tasty
import Text.ParserCombinators.ReadP (readP_to_S)
import Debug.Trace (traceShowId)
argDynamic :: [String]
argDynamic = ["-dynamic" | Gap.hostIsDynamic]
-- | This ghc version is assumed to be tested by CI to validate
-- the "with-compiler" field is honoured by hie-bios.
--
-- If you change this version, make sure to also update 'cabal.project'
-- in 'tests\/projects\/cabal-with-ghc'.
extraGhcVersion :: String
extraGhcVersion = "9.4.8"
extraGhc :: String
extraGhc = "ghc-" ++ extraGhcVersion
-- | To get all logs, run the tests via:
--
-- @
-- cabal run test:bios-tests --test-options="--debug"
-- @
--
-- or
--
-- @
-- TASTY_DEBUG=TRUE cabal test test:bios-tests
-- @
--
-- to avoid recompilation.
main :: IO ()
main = do
for_ [stderr, stdout] (`hSetBuffering` LineBuffering)
writeStackYamlFiles
stackDep <- checkToolIsAvailable "stack"
cabalDep <- checkToolIsAvailable "cabal"
extraGhcDep <- checkToolIsAvailable extraGhc
-- Pre-create the shared extraGhc cabal store. The parallel tests otherwise
-- race to initialise it and can fail with "package.db already exists".
when (toolExists cabalDep && toolExists extraGhcDep) warmupExtraGhcStore
defaultMainWithIngredients (ignoreToolTests:verboseLogging:defaultIngredients) $
-- Run tests sequentially on Windows, to avoid issues with locking of the
-- package database, e.g. errors of the form:
-- package.db/package.cache.lock: openBinaryFile: resource busy (file is locked)
(if isWindows then localOption (Tasty.NumThreads 1) else id) $
testGroup "Bios-tests"
[ testGroup "Find cradle" findCradleTests
, testGroup "Symlink" symbolicLinkTests
, testGroup "Cache files" cacheFileTests
, testGroup "Loading tests"
[ testGroup "bios" biosTestCases
, testGroup "direct" directTestCases
, testGroupWithDependency cabalDep (cabalTestCases cabalDep extraGhcDep)
, ignoreOnUnsupportedGhc $ testGroupWithDependency stackDep stackTestCases
]
]
-- | Load a cabal-with-ghc cradle once to create the extraGhc store. The result
-- is ignored; only the store-creation side effect matters. See 'main'.
warmupExtraGhcStore :: IO ()
warmupExtraGhcStore =
runTestEnv "./cabal-with-ghc"
(initCradle "src/MyLib.hs" *> loadComponentOptions (TargetWithContext "src/MyLib.hs" []))
defConfig
symbolicLinkTests :: [TestTree]
symbolicLinkTests =
[ biosTestCase "Can load base module" $ runTestEnv "./symlink-test" $ do
initCradle "doesNotExist.hs"
assertCradle isMultiCradle
step "Attempt to load symlinked module A"
do
loadComponentOptions $ TargetWithContext "./a/A.hs" []
assertComponentOptions $ \opts ->
componentOptions opts `shouldMatchList` ["a"] <> argDynamic
, biosTestCase "Can load symlinked module" $ runTestEnv "./symlink-test" $ do
initCradle "doesNotExist.hs"
assertCradle isMultiCradle
step "Attempt to load symlinked module A"
do
cradle <- askCradle
let rooted = (cradleRootDir cradle </>)
liftIO $ createDirectoryLink (rooted "a") (rooted "./b")
liftIO $ unlessM (doesFileExist $ rooted "b/A.hs") $
assertFailure "Test invariant broken, this file must exist."
loadComponentOptions $ TargetWithContext "./b/A.hs" []
assertComponentOptions $ \opts ->
componentOptions opts `shouldMatchList` ["b"] <> argDynamic
, biosTestCase "Can not load symlinked module that is ignored" $ runTestEnv "./symlink-test" $ do
initCradle "doesNotExist.hs"
assertCradle isMultiCradle
step "Attempt to load symlinked module A"
do
cradle <- askCradle
let rooted = (cradleRootDir cradle </>)
liftIO $ createDirectoryLink (rooted "./a") (rooted "./c")
liftIO $ unlessM (doesFileExist $ rooted "c/A.hs") $
assertFailure "Test invariant broken, this file must exist."
loadComponentOptions $ TargetWithContext "./c/A.hs" []
assertLoadNone
]
-- | Concurrent 'cacheFileIn' calls can race on the same cache entry.
cacheFileTests :: [TestTree]
cacheFileTests =
[ testCase "cacheFile is atomic under concurrent calls" $ do
withSystemTempDirectory "hie-bios-cache-file-test" $ \testCacheDir -> do
let payloadPrefix = "#!/bin/sh\n"
payloadSuffix = concat (replicate 500 "echo 'cacheFile is atomic under concurrent calls'\n")
payload = payloadPrefix <> payloadSuffix
-- Pause mid-write so a non-atomic populate would expose a partial
-- file, and so all threads pile up on the entry concurrently.
populate fp = do
writeFile fp payloadPrefix
threadDelay 50_000 -- 50ms
appendFile fp payloadSuffix
results <- replicateConcurrently 16 $ try @SomeException $ do
fp <- cacheFileIn (CacheDir testCacheDir) "ghc-pkg" "0123456789abcdef" populate
contents <- readFile fp
contents <$ evaluate (length contents)
forM_ results $ \case
Left err -> assertFailure $ "cacheFile threw: " <> show err
Right contents -> assertEqual "cached file contents" payload contents
]
biosTestCases :: [TestTree]
biosTestCases =
[ biosTestCase "failing-bios" $ runTestEnv "./failing-bios" $ do
initCradle "B.hs"
assertCradle isBiosCradle
loadComponentOptions $ TargetWithContext "B.hs" []
assertCradleError $ \CradleError {..} -> do
cradleErrorExitCode @?= ExitFailure 1
cradleErrorDependencies `shouldMatchList` ["hie.yaml"]
, biosTestCase "failing-bios-ghc" $ runTestEnv "./failing-bios-ghc" $ do
initCradle "B.hs"
assertCradle isBiosCradle
loadRuntimeGhcVersion
ghcVersionLR <- askGhcVersionResult
assertCradleLoadError ghcVersionLR >>= \CradleError {..} -> liftIO $ do
cradleErrorExitCode @?= ExitSuccess
cradleErrorDependencies `shouldMatchList` []
length cradleErrorStderr @?= 1
forM_ cradleErrorStderr $ \errorCtx ->
-- On windows, this error message contains '"' around the executable name
if isWindows
then "Couldn't execute \"myGhc\"" `isPrefixOf` errorCtx @? "Error message should contain error information"
else "Couldn't execute myGhc" `isPrefixOf` errorCtx @? "Error message should contain error information"
, biosTestCase "simple-bios-shell" $ runTestEnv "./simple-bios-shell" $ do
testDirectoryM isBiosCradle $ single "B.hs"
, biosTestCase "simple-bios-shell-deps" $ runTestEnv "./simple-bios-shell" $ do
biosCradleDeps "B.hs" ["hie.yaml"]
] <> concat [linuxTestCases | False] -- TODO(fendor), enable again
where
biosCradleDeps :: FilePath -> [FilePath] -> TestM ()
biosCradleDeps fp deps = do
initCradle fp
assertCradle isBiosCradle
loadComponentOptions $ TargetWithContext fp []
assertComponentOptions $ \opts -> do
deps @?= componentDependencies opts
linuxTestCases =
[ biosTestCase "simple-bios" $ runTestEnv "./simple-bios" $
testDirectoryM isBiosCradle $ single "B.hs"
, biosTestCase "simple-bios-ghc" $ runTestEnv "./simple-bios-ghc" $
testDirectoryM isBiosCradle $ single "B.hs"
, biosTestCase "simple-bios-deps" $ runTestEnv "./simple-bios" $ do
biosCradleDeps "B.hs" ["hie-bios.sh", "hie.yaml"]
, biosTestCase "simple-bios-deps-new" $ runTestEnv "./deps-bios-new" $ do
biosCradleDeps "B.hs" ["hie-bios.sh", "hie.yaml"]
]
cabalTestCases :: ToolDependency -> ToolDependency -> [TestTree]
cabalTestCases cabalDep extraGhcDep =
[
biosTestCaseAll "failing-cabal" $ runTestEnv "./failing-cabal" $ do
attemptCabalSingleTargetLoad "MyLib.hs"
assertCradleError (\CradleError {..} -> do
cradleErrorExitCode @?= ExitFailure 1
cradleErrorDependencies `shouldMatchList` ["failing-cabal.cabal", "cabal.project", "cabal.project.local"])
, biosTestCaseMulti "failing-cabal-multi-repl-with-shrink-error-files" $ runTestEnv "./failing-multi-repl-cabal-project" $ do
attemptCabalLoad "multi-repl-cabal-fail/app/Main.hs" ["multi-repl-cabal-fail/src/Lib.hs", "multi-repl-cabal-fail/src/Fail.hs", "NotInPath.hs"]
root <- askRoot
multiSupported <- isCabalMultipleCompSupportedM
if multiSupported
then
assertCradleError (\CradleError {..} -> do
cradleErrorExitCode @?= ExitFailure 1
cradleErrorDependencies `shouldMatchList` ["cabal.project","cabal.project.local","multi-repl-cabal-fail.cabal"]
-- NotInPath.hs does not match the cradle for `app/Main.hs`, so it should not be tried.
(makeRelative root <$> cradleErrorLoadingFiles) `shouldMatchList` ["multi-repl-cabal-fail/app/Main.hs","multi-repl-cabal-fail/src/Fail.hs","multi-repl-cabal-fail/src/Lib.hs"])
else assertLoadSuccess >>= \ComponentOptions {} -> do
return ()
, biosTestCaseAll "simple-cabal" $ runTestEnv "./simple-cabal" $ do
testDirectoryM isCabalCradle $ single "B.hs"
, biosTestCaseMulti "build-dir" $ runTestEnv "./simple-cabal" $ do
initCradle "B.hs"
assertCradle isCabalCradle
root <- askRoot
buildDir <- liftIO $ do
cacheDir <- resolveCacheDir "" Nothing
cabalBuildDir cacheDir root
-- use --multi-repl, as that was the codepath with the bug
loadFileGhc $ TargetWithContext "B.hs" []
liftIO $ do
-- Check we aren't trampling over dist-newstyle
distNewstyleExists <- doesDirectoryExist (root </> "dist-newstyle")
assertBool "dist-newstyle was created" (not distNewstyleExists)
-- Check we are using the correct build directory
buildDirExists <- doesDirectoryExist buildDir
assertBool "build dir does not exist" buildDirExists
, biosTestCase "custom cache dir" $ runTestEnv "./simple-cabal" $
withSystemTempDirectory "hie-bios-custom-cache-dir" $ \cacheRoot -> do
initCradleWithConfig defaultCradleRunConfig { cradleCacheDir = Just (CacheDir cacheRoot) } "B.hs"
assertCradle isCabalCradle
loadComponentOptions $ TargetWithContext "B.hs" []
_ <- assertLoadSuccess
liftIO $ do
entries <- listDirectory cacheRoot
assertBool ("cache entries under the configured dir: " <> show entries)
(any (\e -> "wrapper" `isInfixOf` e || "dist-" `isPrefixOf` e) entries)
, biosTestCaseAll "nested-cabal" $ runTestEnv "./nested-cabal" $ do
attemptCabalSingleTargetLoad "sub-comp/Lib.hs"
mode <- askLoadMode
assertComponentOptions $ \opts -> do
let
expectedDeps
| mode `elem` [LoadUnitsFromCradle,LoadUnitsInferred]
= [ "nested-cabal.cabal"
, "sub-comp" </> "sub-comp.cabal"
, "cabal.project"
, "cabal.project.local"
]
| otherwise =
[ "sub-comp" </> "sub-comp.cabal"
, "cabal.project"
, "cabal.project.local"
]
componentDependencies opts `shouldMatchList` expectedDeps
, biosTestCaseAll "nested-cabal2" $ runTestEnv "./nested-cabal" $ do
attemptCabalSingleTargetLoad "MyLib.hs"
mode <- askLoadMode
assertComponentOptions $ \opts -> do
let
expectedDeps
| mode `elem` [LoadUnitsFromCradle,LoadUnitsInferred]
= [ "nested-cabal.cabal"
, "sub-comp" </> "sub-comp.cabal"
, "cabal.project"
, "cabal.project.local"
]
| otherwise
= [ "nested-cabal.cabal"
, "cabal.project"
, "cabal.project.local"
]
componentDependencies opts `shouldMatchList` expectedDeps
, biosTestCaseMulti "nested-cabal multi-mode includes enclosing deps for extra files" $ runTestEnv "./nested-cabal" $ do
-- Initialize cradle first, since capability checks use the current cradle.
initCradle "sub-comp/Lib.hs"
assertCradle isCabalCradle
multiSupported <- isCabalMultipleCompSupportedM
if multiSupported
then do
loadComponentOptions $ TargetWithContext "sub-comp/Lib.hs" ["MyLib.hs"]
assertComponentOptions $ \opts -> do
-- Expect both the main component's cabal file and the enclosing cabal for the extra file,
-- plus project files.
componentDependencies opts `shouldMatchList`
[ "sub-comp" </> "sub-comp.cabal"
, "nested-cabal.cabal"
, "cabal.project"
, "cabal.project.local"
]
else do
-- On older cabal/ghc combos, multi-repl isn't supported; just ensure load succeeds.
loadComponentOptions $ TargetWithContext "sub-comp/Lib.hs" []
_ <- assertLoadSuccess
pure ()
, biosTestCaseMulti "nested-cabal multi-mode includes enclosing deps when extra file is subcomp" $ runTestEnv "./nested-cabal" $ do
-- Initialize cradle at the top level, then treat the sub-component file as an extra file.
initCradle "MyLib.hs"
assertCradle isCabalCradle
multiSupported <- isCabalMultipleCompSupportedM
if multiSupported
then do
loadComponentOptions $ TargetWithContext "MyLib.hs" ["sub-comp/Lib.hs"]
assertComponentOptions $ \opts -> do
componentDependencies opts `shouldMatchList`
[ "nested-cabal.cabal"
, "sub-comp" </> "sub-comp.cabal"
, "cabal.project"
, "cabal.project.local"
]
else do
loadComponentOptions $ TargetWithContext "MyLib.hs" []
_ <- assertLoadSuccess
pure ()
, biosTestCaseAll "multi-cabal" $ runTestEnv "./multi-cabal" $ do
{- tests if both components can be loaded -}
testDirectoryM isCabalCradle $ single "app/Main.hs"
testDirectoryM isCabalCradle $ single "src/Lib.hs"
, {- issue https://github.com/mpickering/hie-bios/issues/200 -}
biosTestCaseAll "monorepo-cabal" $ runTestEnv "./monorepo-cabal" $ do
testDirectoryM isCabalCradle $ single "A/Main.hs"
testDirectoryM isCabalCradle $ single "B/MyLib.hs"
, testGroup "Implicit cradle tests" $
[ biosTestCaseAll "implicit-cabal" $ runTestEnv "./implicit-cabal" $ do
testImplicitDirectoryM isCabalCradle $ single "Main.hs"
, biosTestCaseAll "implicit-cabal-no-project" $ runTestEnv "./implicit-cabal-no-project" $ do
testImplicitDirectoryM isCabalCradle $ single "Main.hs"
, biosTestCaseAll "implicit-cabal-deep-project" $ runTestEnv "./implicit-cabal-deep-project" $ do
testImplicitDirectoryM isCabalCradle $ single "foo/Main.hs"
, biosTestCase "implicit-cabal-deep-project-with-context" $ runTestModeEnv "./implicit-cabal-deep-project" LoadFileWithContext $ do
testImplicitDirectoryM isCabalCradle $ ctx "foo/Main.hs" ["Main.hs"]
]
, testGroupWithDependency extraGhcDep
[ biosTestCaseAll "Appropriate ghc and libdir" $ runTestEnv "./cabal-with-ghc" $ do
initCradle "src/MyLib.hs"
assertCradle isCabalCradle
loadRuntimeGhcLibDir
assertLibDirVersionIs extraGhcVersion
loadRuntimeGhcVersion
assertGhcVersionIs extraGhcVersion
step "Find Component Options"
loadComponentOptions $ TargetWithContext "src/MyLib.hs" []
_ <- assertLoadSuccess
pure ()
]
, biosTestCaseAll "cabal-with-project, options propagated" $ runTestEnv "cabal-with-project" $ do
_opts <- cabalLoadOptions "src/MyLib.hs"
assertOptionsContain "-O2" Nothing
, biosTestCaseAll "cabal-with-project, load" $ runTestEnv "cabal-with-project" $ do
testDirectoryM isCabalCradle $ single "src/MyLib.hs"
, biosTestCaseAll "multi-cabal-with-project, options propagated" $ runTestEnv "multi-cabal-with-project" $ do
_optsAppA <- cabalLoadOptions "appA/src/Lib.hs"
assertOptionsContain "-O2" (Just "appA")
, biosTestCaseAll "multi-cabal-with-project, options not propagated" $ runTestEnv "multi-cabal-with-project" $ do
_optsAppB <- cabalLoadOptions "appB/src/Lib.hs"
assertOptionsDoNotContain "-O2" (Just "appB")
, biosTestCaseAll "multi-cabal-with-project, load" $ runTestEnv "multi-cabal-with-project" $ do
testDirectoryM isCabalCradle $ single "appB/src/Lib.hs"
testDirectoryM isCabalCradle $ single "appB/src/Lib.hs"
, testGroupWithDependency extraGhcDep
[ biosTestCaseAll "Honours extra ghc setting" $ runTestEnv "cabal-with-ghc-and-project" $ do
initCradle "src/MyLib.hs"
assertCradle isCabalCradle
loadRuntimeGhcLibDir
assertLibDirVersionIs extraGhcVersion
loadRuntimeGhcVersion
assertGhcVersionIs extraGhcVersion
step "Find Component Options"
loadComponentOptions $ TargetWithContext "src/MyLib.hs" []
_ <- assertLoadSuccess
pure ()
]
, biosTestCase "multi-cabal-with-load" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsFromCradle $ do
opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"
liftIO $ do
unless (any ("appA" `isInfixOf`) opts) $
assertFailure $ "Missing appA: " ++ unwords opts
unless (all (not . ("appB" `isInfixOf`)) opts) $
assertFailure $ "Included appB: " ++ unwords opts
, biosTestCase "multi-cabal-with-load-inferred" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsInferred $ do
-- LoadUnitsInferred should be unaffected by componentsToLoad
opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"
liftIO $ do
unless (any ("appA" `isInfixOf`) opts) $
assertFailure $ "Missing appA: " ++ unwords opts
unless (any ("appB" `isInfixOf`) opts) $
assertFailure $ "Missing appB: " ++ unwords opts
, biosTestCase "cabal-with-load" $ runTestModeEnv "cabal-with-load" LoadUnitsFromCradle $ do
opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"
liftIO $ do
unless (any ("appA" `isInfixOf`) opts) $
assertFailure $ "Missing appA: " ++ unwords opts
unless (all (not . ("appB" `isInfixOf`)) opts) $
assertFailure $ "Included appB: " ++ unwords opts
, biosTestCase "multi-cabal-with-load-superset" $ runTestModeEnv "multi-cabal-with-load-superset" LoadUnitsFromCradle $ do
opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"
liftIO $ do
unless (any ("appA" `isInfixOf`) opts) $
assertFailure $ "Missing appA: " ++ unwords opts
unless (any ("appB" `isInfixOf`) opts) $
assertFailure $ "Missing appB: " ++ unwords opts
, testGroup "custom Cabal"
[ biosTestCaseAll "with-repl fallback" $ runTestEnv "cabal-with-custom-setup-old" $ do
-- Specifically tests whether cabal 3.16 works as expected with
-- an older lib:Cabal version that doesn't support '--with-repl'.
-- This test doesn't hurt for other cases as well, so we enable it for
-- all configurations.
testDirectoryM isCabalCradle $ single "a-with-custom/src/MyLib.hs"
, expectBrokenOnCabal318 cabalDep $ biosTestCaseAll "loads other packages with multi-repl" $ runTestEnv "cabal-with-custom-setup-old" $ do
-- Specifically tests whether cabal 3.16 works as expected with
-- an older lib:Cabal version that doesn't support '--with-repl'.
-- This test doesn't hurt for other cases as well, so we enable it for
-- all configurations.
testDirectoryM isCabalCradle $ ctx "b/src/B.hs" ["b/tests/Main.hs"]
, biosTestCaseAll "custom package and simple package" $ runTestEnv "cabal-with-custom-setup" $ do
testDirectoryM isCabalCradle $ single "b/src/B.hs"
]
]
where
attemptCabalSingleTargetLoad fp = attemptCabalLoad fp []
attemptCabalLoad :: FilePath -> [FilePath] -> TestM ()
attemptCabalLoad fp fps = do
initCradle fp
assertCradle isCabalCradle
loadComponentOptions $ TargetWithContext fp fps
cabalLoadOptions :: FilePath -> TestM ComponentOptions
cabalLoadOptions fp = do
initCradle fp
assertCradle isCabalCradle
loadComponentOptions $ TargetWithContext fp []
assertLoadSuccess
assertOptionsContain :: [Char] -> Maybe String -> TestM ()
assertOptionsContain flag munit = do
doesContain <- hasOption flag munit
liftIO $ doesContain @? ("Options must contain '" ++ flag ++ "'")
assertOptionsDoNotContain :: [Char] -> Maybe String -> TestM ()
assertOptionsDoNotContain flag munit = do
doesContain <- hasOption flag munit
liftIO $ not doesContain @? ("Options must not contain '" ++ flag ++ "'")
hasOption :: [Char] -> Maybe String -> TestM Bool
hasOption flag munit = elem flag <$> do
options <- componentOptions <$> assertLoadSuccess
mode <- askLoadMode
let
common | Nothing <- munit = do
expandGhcOptionResponseFile options
| Just unit <- munit = do
let (units, rest) = extractUnits options
fmap (concat . (rest:)) . forM units $ \ resp_file -> do
unit_flags <- expandGhcOptionResponseFile [resp_file]
if and [ unit `isInfixOf` uid | ("-this-unit-id":uid:_) <- tails unit_flags
]
then pure unit_flags
else pure []
liftIO $ case mode of
LoadFile -> return options
LoadFileWithContext -> expandGhcOptionResponseFile options
LoadUnitsFromCradle -> common
LoadUnitsInferred -> common
stackTestCases :: [TestTree]
stackTestCases =
[ expectFailBecause "stack repl does not fail on an invalid cabal file" $
biosTestCase "failing-stack" $ runTestEnv "./failing-stack" $ do
stackAttemptLoad "src/Lib.hs"
assertCradleError $ \CradleError {..} -> do
cradleErrorExitCode @?= ExitFailure 1
cradleErrorDependencies `shouldMatchList` ["failing-stack.cabal", "stack.yaml", "package.yaml"]
, biosTestCase "simple-stack" $ runTestEnv "./simple-stack" $ do
testDirectoryM isStackCradle $ single "B.hs"
, biosTestCase "multi-stack" $ runTestEnv "./multi-stack" $ do {- tests if both components can be loaded -}
testDirectoryM isStackCradle $ single "app/Main.hs"
testDirectoryM isStackCradle $ single "src/Lib.hs"
, biosTestCaseMulti "multi-stack-multi-modes" $ runTestEnv "./multi-stack" $ do
testDirectoryM isStackCradle $ single "app/Main.hs"
, biosTestCase "nested-stack" $ runTestEnv "./nested-stack" $ do
stackAttemptLoad "sub-comp/Lib.hs"
assertComponentOptions $ \opts ->
componentDependencies opts `shouldMatchList` ["sub-comp" </> "sub-comp.cabal", "sub-comp" </> "package.yaml", "stack.yaml"]
, biosTestCase "nested-stack2" $ runTestEnv "./nested-stack" $ do
stackAttemptLoad "MyLib.hs"
assertComponentOptions $ \opts ->
componentDependencies opts `shouldMatchList` ["nested-stack.cabal", "package.yaml", "stack.yaml"]
, biosTestCase "stack-with-yaml" $ runTestEnv "./stack-with-yaml" $ do
{- tests if both components can be loaded -}
testDirectoryM isStackCradle $ single "app/Main.hs"
testDirectoryM isStackCradle $ single "src/Lib.hs"
, biosTestCase "multi-stack-with-yaml" $ runTestEnv "./multi-stack-with-yaml" $ do
{- tests if both components can be loaded -}
testDirectoryM isStackCradle $ single "appA/src/Lib.hs"
testDirectoryM isStackCradle $ single "appB/src/Lib.hs"
, biosTestCase "multi-stack-with-load" $ runTestModeEnv "multi-stack-with-load" LoadUnitsFromCradle $ do
testDirectoryM isStackCradle $ single "appA/src/LibA.hs"
assertComponentOptions $ \ opts0 -> do
let opts = componentOptions opts0
unless (any ("appA" `isInfixOf`) opts) $
assertFailure $ "Missing appA: " ++ unwords opts
unless (all (not . ("appB" `isInfixOf`)) opts) $
assertFailure $ "Included appB: " ++ unwords opts
, biosTestCase "multi-stack-with-load-inferred" $ runTestModeEnv "multi-stack-with-load" LoadUnitsInferred $ do
testDirectoryM isStackCradle $ single "appA/src/LibA.hs"
assertComponentOptions $ \ opts0 -> do
let opts = componentOptions opts0
unless (any ("appA" `isInfixOf`) opts) $
assertFailure $ "Missing appA: " ++ unwords opts
unless (any ("appB" `isInfixOf`) opts) $
assertFailure $ "Missing appB: " ++ unwords opts
,
-- Test for special characters in the path for parsing of the ghci-scripts.
-- Issue https://github.com/mpickering/hie-bios/issues/162
biosTestCase "space stack" $ runTestEnv "./space stack" $ do
testDirectoryM isStackCradle $ single "A.hs"
testDirectoryM isStackCradle $ single "B.hs"
, testGroup "Implicit cradle tests"
[ biosTestCase "implicit-stack" $ runTestModeEnv "./implicit-stack" LoadFile $ do
testImplicitDirectoryM isStackCradle $ single "Main.hs"
, biosTestCase "implicit-stack-multi" $ runTestModeEnv "./implicit-stack-multi" LoadFile $ do
testImplicitDirectoryM isStackCradle $ single "Main.hs"
testImplicitDirectoryM isStackCradle $ single "other-package/Main.hs"
]
]
where
stackAttemptLoad :: FilePath -> TestM ()
stackAttemptLoad fp = do
initCradle fp
assertCradle isStackCradle
loadComponentOptions $ TargetWithContext fp []
directTestCases :: [TestTree]
directTestCases =
[ biosTestCase "simple-direct" $ runTestEnv "./simple-direct" $ do
testDirectoryM isDirectCradle $ single "B.hs"
, biosTestCase "multi-direct" $ runTestEnv "./multi-direct" $ do
{- tests if both components can be loaded -}
testDirectoryM isMultiCradle $ single "A.hs"
testDirectoryM isMultiCradle $ single "B.hs"
]
findCradleTests :: [TestTree]
findCradleTests =
[ cradleFileTest "Simple Existing File" "./simple-cabal" "B.hs" (Just "hie.yaml")
-- Checks if we can find a hie.yaml even when the given filepath
-- is unknown. This functionality is required by Haskell IDE Engine.
, cradleFileTest "Existing File" "cabal-with-ghc" "src/MyLib.hs" (Just "hie.yaml")
, cradleFileTest "Non-existing file" "cabal-with-ghc" "src/MyLib2.hs" (Just "hie.yaml")
, cradleFileTest "Non-existing file 2" "cabal-with-ghc" "MyLib2.hs" (Just "hie.yaml")
, cradleFileTest "Directory 1" "cabal-with-ghc" "src/" (Just "hie.yaml")
, cradleFileTest "Directory 2" "simple-cabal" "" (Just "hie.yaml")
-- Unknown directory in a project, ought to work as well.
, cradleFileTest "Directory 3" "simple-cabal" "src/" (Just "hie.yaml")
, cradleFileTest "Directory does not exist" "doesnotexist" "A.hs" Nothing
]
where
cradleFileTest :: String -> FilePath -> FilePath -> Maybe FilePath -> TestTree
cradleFileTest testName dir fpTarget result = biosTestCase testName $ do
runTestEnv dir $ do
findCradleForModuleM fpTarget result
-- ------------------------------------------------------------------
-- Unit-test Helper functions
-- ------------------------------------------------------------------
shouldMatchList :: (Show a, Ord a) => [a] -> [a] -> Assertion
shouldMatchList xs ys = sort xs @?= sort ys
infix 1 `shouldMatchList`
biosTestCase :: TestName -> (TestConfig -> Assertion) -> TestTree
biosTestCase name assertion = askOption @VerboseLogging (\case
VerboseLogging verbose ->
testCaseSteps name (\ stepF -> testWrapper verbose stepF)
)
where
testWrapper verbose stepF =
assertion defConfig{testVerbose=verbose,testStepFunction=stepF}
biosTestCaseMulti :: TestName -> (TestConfig -> Assertion) -> TestTree
biosTestCaseMulti name act = testGroup name $ biosTestsForAllModes [LoadFileWithContext .. ] act
biosTestCaseAll :: TestName -> (TestConfig -> Assertion) -> TestTree
biosTestCaseAll name act = testGroup name $ biosTestsForAllModes [minBound .. ] act
biosTestsForAllModes :: [LoadMode] -> (TestConfig -> Assertion) -> [TestTree]
biosTestsForAllModes modes assertion =
[ biosTestCase (show mode) (\ conf -> assertion (conf{testLoadModeConfig=mode}))
| mode <- modes
]
-- ------------------------------------------------------------------
-- Stack related helper functions
-- ------------------------------------------------------------------
writeStackYamlFiles :: IO ()
writeStackYamlFiles =
forM_ stackProjects $ \(proj, syaml, pkgs) ->
writeFile (proj </> syaml) (stackYaml stackYamlResolver pkgs)
stackProjects :: [(FilePath, FilePath, [FilePath])]
stackProjects =
[ ("tests" </> "projects" </> "multi-stack", "stack.yaml", ["."])
, ("tests" </> "projects" </> "failing-stack", "stack.yaml", ["."])
, ("tests" </> "projects" </> "simple-stack", "stack.yaml", ["."])
, ("tests" </> "projects" </> "nested-stack", "stack.yaml", [".", "./sub-comp"])
, ("tests" </> "projects" </> "space stack", "stack.yaml", ["."])
, ("tests" </> "projects" </> "implicit-stack", "stack.yaml", ["."])
, ("tests" </> "projects" </> "implicit-stack-multi", "stack.yaml", ["."])
, ("tests" </> "projects" </> "implicit-stack-multi", "stack.yaml", ["."])
, ("tests" </> "projects" </> "multi-stack-with-yaml", "stack-alt.yaml", ["appA", "appB"])
, ("tests" </> "projects" </> "stack-with-yaml", "stack-alt.yaml", ["."])
, ("tests" </> "projects" </> "multi-stack-with-load", "stack.yaml", ["appA", "appB"])
]
stackYaml :: String -> [FilePath] -> String
stackYaml resolver pkgs = unlines
$ ["resolver: " ++ resolver, "packages:"]
++ map ("- " ++) pkgs
stackYamlResolver :: String
stackYamlResolver =
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,12,0,0)))
"nightly-2025-08-07" -- GHC 9.12.2
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,10,0,0)))
"lts-24.3" -- GHC 9.10.2
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)))
"lts-23.19" -- GHC 9.8.4
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)))
"lts-22.44" -- GHC 9.6.7
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)))
"lts-21.25" -- GHC 9.4.8
#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)))
"lts-20.26" -- GHC 9.2.8
#endif
-- ------------------------------------------------------------------
-- Most tests have some run-time tool dependencies.
-- We only want to run tests if these tools are available.
-- ------------------------------------------------------------------
data ToolDependency = ToolDependency
{ toolName :: String
, toolVersion :: Maybe Version
}
toolExists :: ToolDependency -> Bool
toolExists td = isJust $ toolVersion td
checkToolIsAvailable :: String -> IO ToolDependency
checkToolIsAvailable f = do
mexe <- findExecutable f
version <- case mexe of
Nothing -> pure Nothing
Just exe -> do
versionStr <- readProcess exe ["--numeric-version"] ""
pure $ case readP_to_S parseVersion versionStr of
xs@(_:_) -> Just $ fst $ last xs
[] -> Nothing
pure ToolDependency
{ toolName = f
, toolVersion = version
}
testGroupWithDependency :: ToolDependency -> [TestTree] -> TestTree
testGroupWithDependency td tc = askOption @IgnoreToolDeps (\case
IgnoreToolDeps ignoreToolDep
| ignoreToolDep || toolExists td -> tg
| otherwise -> itg
)
where
tg = testGroup (toolName td) tc
itg =
ignoreTestBecause
("These tests require that the following" ++
" tool can be found on the path: " ++ toolName td)
tg
-- ------------------------------------------------------------------
-- Run test-suite ignoring run-time tool dependencies.
-- Can be used to force CI to run the whole test-suite.
-- Makes sure that the full test-suite is being run on a properly configured
-- environment.
-- ------------------------------------------------------------------
-- | This option, when set to 'True', specifies that we should run in the
-- «list tests» mode
newtype IgnoreToolDeps = IgnoreToolDeps Bool
deriving (Eq, Ord)
instance Tasty.IsOption IgnoreToolDeps where
defaultValue = IgnoreToolDeps False
parseValue = fmap IgnoreToolDeps . Tasty.safeReadBool
optionName = pure "ignore-tool-deps"
optionHelp = pure "Run tests whether their tool dependencies exist or not"
optionCLParser = Tasty.flagCLParser Nothing (IgnoreToolDeps True)
-- | The ingredient that provides the "ignore missing run-time dependencies" functionality
ignoreToolTests :: Tasty.Ingredient
ignoreToolTests = Tasty.TestManager [Tasty.Option (Proxy :: Proxy IgnoreToolDeps)] $
\_opts _tree -> Nothing
newtype VerboseLogging = VerboseLogging Bool
instance Tasty.IsOption VerboseLogging where
defaultValue = VerboseLogging False
parseValue = fmap VerboseLogging . Tasty.safeReadBool
optionName = pure "debug"
optionHelp = pure "Run the tests with verbose logging"
optionCLParser = Tasty.flagCLParser Nothing (VerboseLogging True)
-- | The ingredient that provides the "ignore missing run-time dependencies" functionality
verboseLogging :: Tasty.Ingredient
verboseLogging = Tasty.TestManager [Tasty.Option (Proxy :: Proxy VerboseLogging)] $
\_opts _tree -> Nothing
-- ------------------------------------------------------------------
-- Ignore test group if not supported by any stackage snapshot
-- ------------------------------------------------------------------
ignoreOnUnsupportedGhc :: TestTree -> TestTree
ignoreOnUnsupportedGhc tt =
#if (defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,14,0,0))
ignoreTestBecause "Not supported on GHC 9.14"
#endif
tt
expectBrokenOnCabal318 :: ToolDependency -> TestTree -> TestTree
expectBrokenOnCabal318 td tt =
if traceShowId (traceShowId (toolVersion td) >= Just (makeVersion [3,17,0,0]))
then expectFailBecause
("cabal 3.18 passes all options using response files. \
If old lib:Cabal versions are used, we can't pass '--keep-temp-files' because the configure step rejects it. \
Thus, the response files are deleted before we can parse them. Falling back to the ghc shim wrapper doesn't work either \
since all arguments are passed via response files and we can't see the first argument to be '--interactive' and the wrapper fails.\
"
) tt
else tt