skeletest 0.3.4 → 0.3.5
raw patch · 25 files changed
+546/−277 lines, 25 filesdep +data-defaultPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: data-default
API changes (from Hackage documentation)
+ Skeletest.Internal.Paths: readTestFile :: FilePath -> IO Text
+ Skeletest.Internal.Paths: setOriginalDirectory :: FilePath -> IO ()
+ Skeletest.Internal.Preprocessor: [originalDirectory] :: Options -> FilePath
- Skeletest.Internal.Preprocessor: Options :: Text -> Text -> Options
+ Skeletest.Internal.Preprocessor: Options :: FilePath -> Text -> Text -> Options
- Skeletest.Internal.Preprocessor: defaultOptions :: Options
+ Skeletest.Internal.Preprocessor: defaultOptions :: FilePath -> Options
Files
- CHANGELOG.md +7/−0
- skeletest.cabal +4/−1
- src/Skeletest/Internal/Fixtures.hs +8/−3
- src/Skeletest/Internal/Paths.hs +23/−0
- src/Skeletest/Internal/Plugin.hs +22/−12
- src/Skeletest/Internal/Preprocessor.hs +54/−30
- src/Skeletest/Internal/Snapshot.hs +2/−1
- src/Skeletest/Internal/Spec/Output.hs +8/−8
- src/bin/skeletest-preprocessor.hs +25/−12
- test/Skeletest/AssertionsSpec.hs +43/−30
- test/Skeletest/Internal/CLISpec.hs +9/−7
- test/Skeletest/Internal/CaptureSpec.hs +18/−18
- test/Skeletest/Internal/FixturesSpec.hs +33/−3
- test/Skeletest/Internal/SnapshotSpec.hs +34/−14
- test/Skeletest/Internal/SpecSpec.hs +41/−25
- test/Skeletest/Internal/__snapshots__/FixturesSpec.snap.md +22/−0
- test/Skeletest/Internal/__snapshots__/SpecSpec.snap.md +12/−0
- test/Skeletest/MainSpec.hs +13/−14
- test/Skeletest/OptionsSpec.hs +33/−0
- test/Skeletest/PluginSpec.hs +10/−8
- test/Skeletest/PredicateSpec.hs +19/−23
- test/Skeletest/PropSpec.hs +8/−6
- test/Skeletest/TestUtils/Integration.hs +84/−60
- test/Skeletest/__snapshots__/AssertionsSpec.snap.md +14/−0
- test/Skeletest/__snapshots__/MainSpec.snap.md +0/−2
CHANGELOG.md view
@@ -1,3 +1,10 @@+## v0.3.5++Runtime changes:+* Fix circular dependency error when a session-scoped fixture errors ([#72](https://github.com/brandonchinn178/skeletest/issues/72))+* Fix `P.matchesSnapshot` when test changes CWD ([#44](https://github.com/brandonchinn178/skeletest/issues/44))+* Fix test failure messages when running test executable from different directory ([#74](https://github.com/brandonchinn178/skeletest/issues/74))+ ## v0.3.4 API changes:
skeletest.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: skeletest-version: 0.3.4+version: 0.3.5 synopsis: Batteries-included, opinionated test framework description: Batteries-included, opinionated test framework. See README.md for more details. homepage: https://github.com/brandonchinn178/skeletest#readme@@ -44,6 +44,7 @@ Skeletest.Internal.GHC Skeletest.Internal.GHC.Compat Skeletest.Internal.Markers+ Skeletest.Internal.Paths Skeletest.Internal.Plugin Skeletest.Internal.Predicate Skeletest.Internal.Preprocessor@@ -129,6 +130,7 @@ Skeletest.Internal.SpecSpec Skeletest.Internal.TestTargetsSpec Skeletest.MainSpec+ Skeletest.OptionsSpec Skeletest.PluginSpec Skeletest.PredicateSpec Skeletest.PropSpec@@ -137,6 +139,7 @@ base , aeson , containers+ , data-default , directory , filepath , skeletest
src/Skeletest/Internal/Fixtures.hs view
@@ -90,6 +90,7 @@ PerSessionFixture -> pure PerSessionFixtureKey let insertFixture state = updateScopedFixtures (OMap.>| (rep, state))+ let rmFixture = updateScopedFixtures (OMap.delete rep) cachedFixture <- modifyFixtureRegistry $ \registry ->@@ -118,9 +119,13 @@ Right (Just fixture) -> pure fixture -- otherwise, execute it (allowing it to request other fixtures) and cache the result. Right Nothing -> do- result@(fixture, _) <- fixtureAction @a- modifyFixtureRegistry $ \registry -> (insertFixture (FixtureLoaded result) registry, ())- pure fixture+ tryAny (fixtureAction @a) >>= \case+ Left e -> do+ modifyFixtureRegistry $ \registry -> (rmFixture registry, ())+ throwIO e+ Right result@(fixture, _) -> do+ modifyFixtureRegistry $ \registry -> (insertFixture (FixtureLoaded result) registry, ())+ pure fixture where rep = typeRep (Proxy @a) isInProgress = \case
+ src/Skeletest/Internal/Paths.hs view
@@ -0,0 +1,23 @@+module Skeletest.Internal.Paths (+ setOriginalDirectory,+ readTestFile,+) where++import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text.IO qualified as Text+import Skeletest.Internal.Error (invariantViolation)+import System.FilePath ((</>))+import System.IO.Unsafe (unsafePerformIO)++originalDirectoryRef :: IORef FilePath+originalDirectoryRef = unsafePerformIO $ newIORef (invariantViolation "Original directory not set")+{-# NOINLINE originalDirectoryRef #-}++setOriginalDirectory :: FilePath -> IO ()+setOriginalDirectory = writeIORef originalDirectoryRef++readTestFile :: FilePath -> IO Text+readTestFile fp = do+ dir <- readIORef originalDirectoryRef+ Text.readFile $ dir </> fp
src/Skeletest/Internal/Plugin.hs view
@@ -15,6 +15,7 @@ import Skeletest.Internal.Constants (mainFileSpecsListIdentifier) import Skeletest.Internal.Error (skeletestPluginError) import Skeletest.Internal.GHC+import Skeletest.Internal.Paths (setOriginalDirectory) import Skeletest.Internal.Predicate qualified as P import Skeletest.Internal.Preprocessor qualified as Preprocessor import Skeletest.Internal.Utils.HList (HList (..))@@ -72,20 +73,29 @@ { funType = HsTypeApps (HsTypeCon $ hsName ''IO) [HsTypeTuple []] , funPats = [] , funBody =- hsExprApps- (hsExprVar $ hsName 'Main.runSkeletest)- [ hsExprApps (hsExprVar (hsName '(:))) $- [ hsExprRecordCon- (hsName 'Plugin.Plugin)- [ (hsFieldName 'Plugin.Plugin "cliFlags", cliFlagsExpr)- , (hsFieldName 'Plugin.Plugin "snapshotRenderers", snapshotRenderersExpr)- , (hsFieldName 'Plugin.Plugin "hooks", hooksExpr)- ]- , pluginsExpr- ]- , hsExprVar $ hsVarName mainFileSpecsListIdentifier+ sequenceExpr+ [ setOriginalDirectoryExpr+ , runSkeletestExpr ] }+ sequenceExpr exprs = hsExprApps (hsExprVar $ hsName 'sequence_) [hsExprList exprs]+ setOriginalDirectoryExpr =+ hsExprApps (hsExprVar $ hsName 'setOriginalDirectory) $+ [hsExprLitString . Text.pack $ options.originalDirectory]+ runSkeletestExpr =+ hsExprApps+ (hsExprVar $ hsName 'Main.runSkeletest)+ [ hsExprApps (hsExprVar (hsName '(:))) $+ [ hsExprRecordCon+ (hsName 'Plugin.Plugin)+ [ (hsFieldName 'Plugin.Plugin "cliFlags", cliFlagsExpr)+ , (hsFieldName 'Plugin.Plugin "snapshotRenderers", snapshotRenderersExpr)+ , (hsFieldName 'Plugin.Plugin "hooks", hooksExpr)+ ]+ , pluginsExpr+ ]+ , hsExprVar $ hsVarName mainFileSpecsListIdentifier+ ] transformTestModule :: Ctx -> HsExpr GhcRn -> HsExpr GhcRn transformTestModule ctx =
src/Skeletest/Internal/Preprocessor.hs view
@@ -9,8 +9,12 @@ decodeOptions, ) where -import Control.Monad (guard)+import Control.Monad (guard, when, (>=>))+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except qualified as Except+import Control.Monad.Trans.State.Strict qualified as State import Data.Char (isDigit, isLower, isUpper)+import Data.Functor.Identity (Identity (runIdentity)) import Data.List (sort) import Data.Maybe (mapMaybe) import Data.Text (Text)@@ -20,18 +24,20 @@ import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (makeRelative, splitExtensions, takeDirectory, (</>)) import Text.Read (readMaybe)-import UnliftIO.Exception (throwIO)+import UnliftIO.Exception (fromEither) data Options = Options- { mainModuleName :: Text+ { originalDirectory :: FilePath+ , mainModuleName :: Text , mainFuncName :: Text } deriving (Show, Read) -defaultOptions :: Options-defaultOptions =+defaultOptions :: FilePath -> Options+defaultOptions originalDirectory = Options- { mainModuleName = "Main"+ { originalDirectory+ , mainModuleName = "Main" , mainFuncName = "main" } @@ -96,10 +102,12 @@ updateMainFile :: FilePath -> Text -> IO Text updateMainFile path file = do modules <- findTestModules path- either throwIO pure $- pure file- >>= insertImports modules- >>= pure . addSpecsList modules+ fromEither $+ runMainFileTransformer+ ( addSpecsList modules+ >=> insertImports -- Must be last!+ )+ file -- | Find all test modules using the given path to the Main module. --@@ -127,39 +135,55 @@ guard $ Text.all (\c -> isUpper c || isLower c || isDigit c || c == '\'') rest pure name -addSpecsList :: [(FilePath, Text)] -> Text -> Text-addSpecsList testModules file =- Text.unlines+{----- Main file generation -----}++type ImportDef = (Text, Text) -- (module name, qualified as)+type MainFileTransformerM a = State.StateT [ImportDef] (Except.ExceptT SkeletestError Identity) a+type MainFileTransformer = Text -> MainFileTransformerM Text++runMainFileTransformer :: MainFileTransformer -> Text -> Either SkeletestError Text+runMainFileTransformer transform =+ runIdentity+ . Except.runExceptT+ . (`State.evalStateT` [])+ . transform++addImport :: ImportDef -> MainFileTransformerM ()+addImport i = State.modify (i :)++addSpecsList :: [(FilePath, Text)] -> MainFileTransformer+addSpecsList testModules file = do+ specsList <- mapM mkSpecDef testModules+ pure . Text.unlines $ [ file , mainFileSpecsListIdentifier <> " :: [(FilePath, Spec)]"- , mainFileSpecsListIdentifier <> " = " <> renderSpecList specsList+ , mainFileSpecsListIdentifier <> " = " <> (renderList . map renderPair) specsList ] where- specsList =- [ (quote $ Text.pack fp, modName <> ".spec")- | (fp, modName) <- testModules- ]+ mkSpecDef (fp, modName) = do+ addImport (modName, modName)+ pure (quote $ Text.pack fp, modName <> ".spec") quote s = "\"" <> s <> "\""- renderSpecList xs = "[" <> (Text.intercalate ", " . map renderSpecInfo) xs <> "]"- renderSpecInfo (fp, spec) = "(" <> fp <> ", " <> spec <> ")"+ renderList xs = "[" <> Text.intercalate ", " xs <> "]"+ renderPair (x, y) = "(" <> x <> ", " <> y <> ")" -- | Add imports after the Skeletest.Main import, which should always be present in the Main module.-insertImports :: [(FilePath, Text)] -> Text -> Either SkeletestError Text-insertImports testModules file =+insertImports :: MainFileTransformer+insertImports file = do+ imports <- State.get+ let (pre, post) = break isSkeletestImport $ Text.lines file- in if null post- then Left $ CompilationError Nothing "Could not find Skeletest.Main import in Main module"- else pure . Text.unlines $ pre <> importTests <> post+ when (null post) $ do+ lift . Except.throwE $+ CompilationError Nothing "Could not find Skeletest.Main import in Main module"++ pure . Text.unlines $ pre <> map mkImport imports <> post where isSkeletestImport line = case Text.words line of "import" : "Skeletest.Main" : _ -> True _ -> False-- importTests =- [ "import qualified " <> name- | (_, name) <- testModules- ]+ mkImport (name, alias) = "import qualified " <> name <> " as " <> alias {----- Helpers -----}
src/Skeletest/Internal/Snapshot.hs view
@@ -58,6 +58,7 @@ noCleanup, withCleanup, )+import Skeletest.Internal.Paths (readTestFile) import Skeletest.Internal.TestInfo (TestInfo (..), getTestInfo) import Skeletest.Internal.Utils.Map qualified as Map.Utils import System.Directory (createDirectoryIfMissing)@@ -101,7 +102,7 @@ let snapshotPath = getSnapshotPath file mSnapshotFile <-- try (Text.readFile snapshotPath) >>= \case+ try (readTestFile snapshotPath) >>= \case Left e | isDoesNotExistError e -> pure Nothing | otherwise -> throwIO e
src/Skeletest/Internal/Spec/Output.hs view
@@ -18,6 +18,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as Text+import Skeletest.Internal.Paths (readTestFile) import System.Console.Terminal.Size qualified as Term import System.IO qualified as IO import UnliftIO.Exception (SomeException, try)@@ -91,19 +92,18 @@ where renderCallLine (path, lineNum, startCol, endCol) = do mLine <-- try (Text.readFile path) >>= \case- Right srcFile -> pure $ getLineNum lineNum srcFile- Left (_ :: SomeException) -> pure Nothing+ try (readTestFile path) >>= \case+ Right srcFile+ | Just line <- getLineNum lineNum srcFile -> pure $ Right line+ | otherwise -> pure $ Left "<line does not exist>"+ Left (_ :: SomeException) -> pure $ Left "<could not open file>" let (srcLine, pointerLine) = case mLine of- Just line ->+ Right line -> ( line , Text.replicate (startCol - 1) " " <> Text.replicate (endCol - startCol) "^" )- Nothing ->- ( "<unknown line>"- , ""- )+ Left e -> (e, "") pure . Text.intercalate "\n" $ [ Text.pack path <> ":" <> (Text.pack . show) lineNum <> ":"
src/bin/skeletest-preprocessor.hs view
@@ -23,27 +23,30 @@ import Data.Char (isUpper) import Data.Foldable (foldlM) import Data.List (dropWhileEnd)+import Data.Text qualified as Text import Data.Text.IO qualified as Text import GHC.IO.Encoding (setLocaleEncoding, utf8)+import Skeletest.Internal.Error (SkeletestError)+import Skeletest.Internal.Preprocessor (processFile)+import Skeletest.Internal.Preprocessor qualified as Preprocessor import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr)+import UnliftIO.Directory (getCurrentDirectory) import UnliftIO.Exception (displayException, handle) -import Data.Text qualified as Text-import Skeletest.Internal.Error (SkeletestError)-import Skeletest.Internal.Preprocessor (processFile)-import Skeletest.Internal.Preprocessor qualified as Preprocessor- main :: IO () main = handleErrors $ do -- just to be extra sure we don't run into encoding issues setLocaleEncoding utf8 + cwd <- getCurrentDirectory+ let initialOpts = Preprocessor.defaultOptions cwd+ getArgs >>= \case -- https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#options-affecting-a-haskell-pre-processor fp : input : output : args -> do- options <- either error pure $ foldlM parseOpts Preprocessor.defaultOptions args+ options <- either error pure $ foldlM parseOpts initialOpts args Text.readFile input >>= processFile options fp >>= Text.writeFile output _ -> error "The skeletest preprocessor expects at least three arguments." @@ -58,15 +61,25 @@ | otherwise = id parseOpts :: Preprocessor.Options -> String -> Either String Preprocessor.Options-parseOpts opts argStr- | Just (mMainMod, mMainFunc) <- Text.stripPrefix "main:" arg >>= parseMain =- Right+parseOpts opts arg = do+ (name, val) <-+ case Text.breakOn ":" (Text.pack arg) of+ (name, rest) | Just value <- Text.stripPrefix ":" rest -> pure (name, value)+ _ -> Left $ "Option must be in the format 'name:value', got: " <> show arg+ parse <- getParser name+ case parse val of+ Just a -> Right a+ Nothing -> Left $ "Option '" <> Text.unpack name <> "' got invalid value: " <> show val+ where+ getParser = \case+ "main" -> Right $ \val -> do+ (mMainMod, mMainFunc) <- parseMain val+ Just . maybe id (\s o -> o{Preprocessor.mainModuleName = s}) mMainMod . maybe id (\s o -> o{Preprocessor.mainFuncName = s}) mMainFunc $ opts- | otherwise = Left $ "Unknown option: " <> argStr- where- arg = Text.pack argStr+ name -> Left $ "Unknown option: " <> Text.unpack name+ parseMain s = case Text.splitOn "." s of [modName, modFunc] -> Just (Just modName, Just modFunc)
test/Skeletest/AssertionsSpec.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedRecordDot #-} module Skeletest.AssertionsSpec (spec) where @@ -17,8 +18,8 @@ 1 `shouldBe` (1 :: Int) integration . it "should show helpful failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -26,7 +27,7 @@ , "spec = it \"should fail\" $ 1 `shouldBe` (2 :: Int)" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot @@ -35,8 +36,8 @@ 1 `shouldNotBe` (2 :: Int) integration . it "should show helpful failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -44,7 +45,7 @@ , "spec = it \"should fail\" $ 1 `shouldNotBe` (1 :: Int)" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot @@ -53,8 +54,8 @@ 1 `shouldSatisfy` P.gt (0 :: Int) integration . it "should show helpful failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -63,7 +64,7 @@ , "spec = it \"should fail\" $ (-1) `shouldSatisfy` P.gt (0 :: Int)" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot @@ -72,8 +73,8 @@ (-1) `shouldNotSatisfy` P.gt (0 :: Int) integration . it "should show helpful failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -82,7 +83,7 @@ , "spec = it \"should fail\" $ 1 `shouldNotSatisfy` P.gt (0 :: Int)" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot @@ -91,8 +92,8 @@ pure 1 `shouldReturn` (1 :: Int) integration . it "should show helpful failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -100,14 +101,14 @@ , "spec = it \"should fail\" $ pure 1 `shouldReturn` (2 :: Int)" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot describe "context" $ do integration . it "should show failure context" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -117,14 +118,14 @@ , " 1 `shouldBe` (2 :: Int)" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot describe "failTest" $ do integration . it "should show failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -132,13 +133,13 @@ , "spec = it \"should fail\" $ failTest \"error message\"" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "shows backtrace of failed assertions" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -153,13 +154,13 @@ , "expectGT x actual = actual `shouldSatisfy` P.gt x" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "shows helpful error on pattern match fail" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -170,13 +171,13 @@ , " x `shouldBe` True" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "shows unrecognized exceptions" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -187,9 +188,21 @@ , " pure ()" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" sanitizeTraceback stdout `shouldSatisfy` P.matchesSnapshot++ integration . it "shows source code when running from different directory" $ do+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $+ [ "module ExampleSpec (spec) where"+ , "import Skeletest"+ , "spec = it \"should fail\" $ failTest \"failure\""+ ]++ (stdout, stderr) <- expectFailure $ runner.runTestsWith def{cwd = Just "/"}+ stderr `shouldBe` ""+ stdout `shouldSatisfy` P.matchesSnapshot -- GHC 9.10 specifically added a backtrace to SomeException, which was reverted in 9.12 -- https://github.com/haskell/core-libraries-committee/issues/285
test/Skeletest/Internal/CLISpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ module Skeletest.Internal.CLISpec (spec) where import Control.Monad ((>=>))@@ -42,13 +44,13 @@ describe "getFlag" $ do integration . it "reads registered flag" $ do- runner <- getFixture- setMainFile runner $+ runner <- getFixture @TestRunner+ runner.setMainFile [ "import Skeletest.Main" , "import ExampleSpec (MyFlag)" , "cliFlags = [flag @MyFlag]" ]- addTestFile runner "ExampleSpec.hs" $+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (MyFlag, spec) where" , "import Skeletest" , ""@@ -63,12 +65,12 @@ , " s `shouldBe` \"hello world\"" ] - _ <- expectSuccess $ runTests runner ["--my-flag", "hello world"]+ _ <- expectSuccess $ runner.runTestsWith def{cliArgs = ["--my-flag", "hello world"]} pure () integration . it "errors if flag is not registered" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -84,7 +86,7 @@ , " pure ()" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot
test/Skeletest/Internal/CaptureSpec.hs view
@@ -25,8 +25,8 @@ runtimeSpec handle = do describe handle $ do integration . it "is hidden on test success" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "{-# LANGUAGE OverloadedRecordDot #-}" , "{-# LANGUAGE OverloadedStrings #-}" , "module ExampleSpec (spec) where"@@ -41,14 +41,14 @@ , " " <> render_hPutStrLn handle "line1" , " " <> render_hPutStrLn handle "line2" ]- (code, stdout, stderr) <- runTests runner []+ (code, stdout, stderr) <- runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot code `shouldBe` ExitSuccess integration . it "is rendered on test failure" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "{-# LANGUAGE OverloadedRecordDot #-}" , "{-# LANGUAGE OverloadedStrings #-}" , "module ExampleSpec (spec) where"@@ -64,13 +64,13 @@ , " " <> render_hPutStrLn handle "line2" , " 1 `shouldBe` 2" ]- (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "is rendered on test error" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "{-# LANGUAGE OverloadedRecordDot #-}" , "{-# LANGUAGE OverloadedStrings #-}" , "module ExampleSpec (spec) where"@@ -87,13 +87,13 @@ , " Just _ <- pure Nothing" , " pure ()" ]- (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "is not captured with --capture-output=off" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "{-# LANGUAGE OverloadedRecordDot #-}" , "{-# LANGUAGE OverloadedStrings #-}" , "module ExampleSpec (spec) where"@@ -108,7 +108,7 @@ , " " <> render_hPutStrLn handle "line1" , " " <> render_hPutStrLn handle "line2" ]- (code, stdout, stderr) <- runTests runner ["--capture-output=off"]+ (code, stdout, stderr) <- runner.runTestsWith def{cliArgs = ["--capture-output=off"]} List.intercalate "\n\n" [">>> stdout", stdout, ">>> stderr", stderr] `shouldSatisfy` P.matchesSnapshot code `shouldBe` ExitSuccess @@ -116,8 +116,8 @@ fixtureGetSpec (handle, func) = describe func $ do integration . it "returns captured output from current test" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "{-# LANGUAGE OverloadedRecordDot #-}" , "{-# LANGUAGE OverloadedStrings #-}" , "module ExampleSpec (spec) where"@@ -139,15 +139,15 @@ , " s <- output." <> func , " s `shouldBe` " <> show "test1\ntest2\n" ]- _ <- expectSuccess $ runTests runner []+ _ <- expectSuccess runner.runTests pure () fixtureReadSpec :: (String, String) -> Spec fixtureReadSpec (handle, func) = describe func $ do integration . it "returns captured output from current test" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "{-# LANGUAGE OverloadedRecordDot #-}" , "{-# LANGUAGE OverloadedStrings #-}" , "module ExampleSpec (spec) where"@@ -169,7 +169,7 @@ , " s <- output." <> func , " s `shouldBe` " <> show "test2\n" ]- _ <- expectSuccess $ runTests runner []+ _ <- expectSuccess runner.runTests pure () render_hPutStrLn :: String -> String -> String
test/Skeletest/Internal/FixturesSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ module Skeletest.Internal.FixturesSpec (spec) where import Skeletest@@ -8,7 +10,7 @@ spec = do describe "getFixture" $ do integration . it "detects circular dependencies" $ do- runner <- getFixture+ runner <- getFixture @TestRunner -- Fixture graph: -- A@@ -16,7 +18,7 @@ -- -> C -- -> D -- -> A- addTestFile runner "ExampleSpec.hs" $+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -51,6 +53,34 @@ , " pure ()" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests+ stderr `shouldBe` ""+ stdout `shouldSatisfy` P.matchesSnapshot++ -- https://github.com/brandonchinn178/skeletest/issues/72+ integration . it "throws the appropriate error when setup fails" $ do+ runner <- getFixture @TestRunner++ runner.addTestFile "ExampleSpec.hs" $+ [ "module ExampleSpec (spec) where"+ , ""+ , "import Skeletest"+ , ""+ , "data FixtureA = FixtureA"+ , ""+ , "instance Fixture FixtureA where"+ , " fixtureScope = PerSessionFixture"+ , " fixtureAction = failTest \"Fixture setup failed\""+ , ""+ , "spec = do"+ , " it \"should error\" $ do"+ , " FixtureA <- getFixture"+ , " pure ()"+ , " it \"should error again\" $ do"+ , " FixtureA <- getFixture"+ , " pure ()"+ ]++ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot
test/Skeletest/Internal/SnapshotSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -31,8 +32,8 @@ normalizeSnapshotFile' file `shouldBe` normalizeSnapshotFile file integration . it "detects corrupted snapshot files" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -41,26 +42,26 @@ , "spec = it \"should error\" $ do" , " \"\" `shouldSatisfy` P.matchesSnapshot" ]- addTestFile runner "__snapshots__/ExampleSpec.snap.md" ["asdf"]+ runner.addTestFile "__snapshots__/ExampleSpec.snap.md" ["asdf"] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "uses registered snapshot renderers" $ do- runner <- getFixture- setMainFile runner $+ runner <- getFixture @TestRunner+ runner.setMainFile [ "import Skeletest.Main" , "import Lib.User" , "snapshotRenderers =" , " [ renderWithShow @User" , " ]" ]- addTestFile runner "Lib/User.hs" $+ runner.addTestFile "Lib/User.hs" $ [ "module Lib.User (User (..)) where" , "data User = User {name :: String, age :: Int} deriving (Show)" ]- addTestFile runner "ExampleSpec.hs" $+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Lib.User"@@ -72,8 +73,8 @@ , " testUser `shouldSatisfy` P.matchesSnapshot" ] - _ <- expectSuccess $ runTests runner ["-u"]- snapshot <- readTestFile runner "__snapshots__/ExampleSpec.snap.md"+ _ <- expectSuccess $ runner.runTestsWith def{cliArgs = ["-u"]}+ snapshot <- runner.readTestFile "__snapshots__/ExampleSpec.snap.md" snapshot `shouldSatisfy` P.hasInfix "User {name = \"Alice\", age = 30}" it "renders JSON values" $ do@@ -81,8 +82,8 @@ (result :: Maybe Aeson.Value) `shouldSatisfy` P.just P.matchesSnapshot integration . it "shows helpful failure messages" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -91,7 +92,7 @@ , "spec = it \"fails\" $ do" , " unlines [\"new1\", \"same1\", \"same2\", \"new2\"] `shouldSatisfy` P.matchesSnapshot" ]- addTestFile runner "__snapshots__/ExampleSpec.snap.md" $+ runner.addTestFile "__snapshots__/ExampleSpec.snap.md" $ [ "# Example" , "" , "## fails"@@ -104,9 +105,28 @@ , "```" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot++ integration . it "works when test changes directories" $ do+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $+ [ "module ExampleSpec (spec) where"+ , ""+ , "import Skeletest"+ , "import qualified Skeletest.Predicate as P"+ , "import System.Directory (withCurrentDirectory)"+ , ""+ , "spec = it \"tests snapshot\" $ do"+ , " withCurrentDirectory \"/\" $ do"+ , " (123 :: Int) `shouldSatisfy` P.matchesSnapshot"+ ]++ let args = def{ghcArgs = ["-package", "directory"]}+ _ <- expectSuccess $ runner.runTestsWith args{cliArgs = ["-u"]}+ _ <- expectSuccess $ runner.runTestsWith args+ pure () genSnapshotFileRaw :: Gen SnapshotFile genSnapshotFileRaw = do
test/Skeletest/Internal/SpecSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ module Skeletest.Internal.SpecSpec (spec) where import Skeletest@@ -8,8 +10,8 @@ spec = do describe "skip" $ do integration . it "skips tests completely" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -19,14 +21,14 @@ , " it \"should not run either\" $ undefined" ] - (stdout, stderr) <- expectSuccess $ runTests runner []+ (stdout, stderr) <- expectSuccess runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot describe "xfail" $ do integration . it "checks for expected failures" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -36,13 +38,13 @@ , " it \"should fail too\" $ undefined" ] - (stdout, stderr) <- expectSuccess $ runTests runner []+ (stdout, stderr) <- expectSuccess runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "errors on unexpected passes" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -52,15 +54,14 @@ , " it \"should fail too\" $ pure ()" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot describe "focus" $ do- -- TODO: test that using focus with -Werror fails integration . it "only runs focused test" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -70,13 +71,28 @@ , " it \"not working yet\" $ failTest \"broken\"" ] - (stdout, _) <- expectSuccess $ runTests runner []+ (stdout, _) <- expectSuccess runner.runTests stdout `shouldSatisfy` P.matchesSnapshot + integration . it "fails with -Werror" $ do+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $+ [ "module ExampleSpec (spec) where"+ , ""+ , "import Skeletest"+ , ""+ , "spec = do"+ , " focus . it \"in progress\" $ pure ()"+ , " it \"not working yet\" $ failTest \"broken\""+ ]++ (_, stderr) <- expectFailure $ runner.runTestsWith def{ghcArgs = ["-Werror"]}+ stderr `shouldSatisfy` P.matchesSnapshot+ describe "markManual" $ do integration . it "skips manual tests by default" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -89,7 +105,7 @@ , " it \"bar2\" $ pure ()" ] - (stdout, stderr) <- expectSuccess $ runTests runner []+ (stdout, stderr) <- expectSuccess runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.and@@ -100,8 +116,8 @@ ] integration . it "runs selected manual tests" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -114,7 +130,7 @@ , " it \"bar2\" $ pure ()" ] - (stdout, stderr) <- expectSuccess $ runTests runner ["*"]+ (stdout, stderr) <- expectSuccess $ runner.runTestsWith def{cliArgs = ["*"]} stderr `shouldBe` "" stdout `shouldSatisfy` P.and@@ -126,8 +142,8 @@ describe "withMarkers" $ do integration . it "allows selecting from command line" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -140,7 +156,7 @@ , " it \"bar2\" $ pure ()" ] - (stdout, stderr) <- expectSuccess $ runTests runner ["@foo"]+ (stdout, stderr) <- expectSuccess $ runner.runTestsWith def{cliArgs = ["@foo"]} stderr `shouldBe` "" stdout `shouldSatisfy` P.and@@ -152,8 +168,8 @@ describe "withMarker" $ do integration . it "allows selecting from command line" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -169,7 +185,7 @@ , " it \"bar2\" $ pure ()" ] - (stdout, stderr) <- expectSuccess $ runTests runner ["@my-marker"]+ (stdout, stderr) <- expectSuccess $ runner.runTestsWith def{cliArgs = ["@my-marker"]} stderr `shouldBe` "" stdout `shouldSatisfy` P.and
test/Skeletest/Internal/__snapshots__/FixturesSpec.snap.md view
@@ -8,3 +8,25 @@ │ Found circular dependency when resolving fixtures: FixtureA -> FixtureB -> FixtureD -> FixtureA ╰──────────────────────────────────────────────────────────────────────────────────────────────── ```++## getFixture / throws the appropriate error when setup fails++```+./ExampleSpec.hs+╭── should error: FAIL+│ ./ExampleSpec.hs:9:+│ │+│ │ fixtureAction = failTest "Fixture setup failed"+│ │ ^^^^^^^^+│ +│ Fixture setup failed+╰───────────────────────────────────────────────────────────────────────────────+╭── should error again: FAIL+│ ./ExampleSpec.hs:9:+│ │+│ │ fixtureAction = failTest "Fixture setup failed"+│ │ ^^^^^^^^+│ +│ Fixture setup failed+╰───────────────────────────────────────────────────────────────────────────────+```
test/Skeletest/Internal/__snapshots__/SpecSpec.snap.md view
@@ -1,5 +1,17 @@ # test/Skeletest/Internal/SpecSpec.hs +## focus / fails with -Werror++```+ExampleSpec.hs:6:3: error: [GHC-63394] [-Wx-focused-tests, -Werror=x-focused-tests]+ In the use of ‘focus’+ (imported from Skeletest, but defined in Skeletest.Internal.Spec.Tree):+ "focus should only be used in development"+ |+6 | focus . it "in progress" $ pure ()+ | ^^^^^+```+ ## focus / only runs focused test ```
test/Skeletest/MainSpec.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedRecordDot #-} module Skeletest.MainSpec (spec) where @@ -10,41 +11,39 @@ spec :: Spec spec = do integration . it "errors if Skeletest.Main not imported" $ do- runner <- getFixture- setMainFile runner []- addTestFile runner "ExampleSpec.hs" (minimalTest "ExampleSpec")+ runner <- getFixture @TestRunner+ runner.setMainFile []+ runner.addTestFile "ExampleSpec.hs" (minimalTest "ExampleSpec") - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests normalizePluginError stderr `shouldSatisfy` P.matchesSnapshot integration . it "ignores non-test files" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "import Skeletest" , "import TestUtils" , "spec = it \"should run\" $ testUserName `shouldBe` \"Alice\"" ]- addTestFile runner "TestUtils.hs" $+ runner.addTestFile "TestUtils.hs" $ [ "module TestUtils where" , "testUserName = \"Alice\"" ] - _ <- expectSuccess $ runTests runner []+ _ <- expectSuccess runner.runTests pure () integration . it "errors if main function defined" $ do- runner <- getFixture- setMainFile runner $+ runner <- getFixture @TestRunner+ runner.setMainFile [ "import Skeletest.Main" , "" , "main = putStrLn \"hello world\"" ]- addTestFile runner "ExampleSpec.hs" (minimalTest "ExampleSpec")+ runner.addTestFile "ExampleSpec.hs" (minimalTest "ExampleSpec") - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests normalizeGhc29916 stderr `shouldSatisfy` P.matchesSnapshot minimalTest :: String -> FileContents
+ test/Skeletest/OptionsSpec.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedRecordDot #-}++module Skeletest.OptionsSpec (spec) where++import Skeletest+import Skeletest.TestUtils.Integration++spec :: Spec+spec = do+ describe "main" $ do+ integration . it "works with 'MyMain'" $ do+ runner <- getFixture @TestRunner+ runner.setMainFile+ [ "module MyMain where"+ , "import Skeletest.Main"+ ]+ runner.addTestFile "ExampleSpec.hs" $+ [ "module ExampleSpec (spec) where"+ , "import Skeletest"+ , "spec = it \"should run\" $ pure ()"+ ]+ let args =+ def+ { mainFile = "MyMain.hs"+ , ghcArgs =+ [ "-optF=main:MyMain"+ , "-main-is"+ , "MyMain"+ ]+ }+ (stdout, stderr) <- expectSuccess $ runner.runTestsWith args+ stderr `shouldBe` ""+ stdout `shouldNotBe` ""
test/Skeletest/PluginSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ module Skeletest.PluginSpec (spec) where import Skeletest@@ -8,8 +10,8 @@ spec = do describe "runTest" $ do integration . it "allows hooking into test execution" $ do- runner <- getFixture- setMainFile runner $+ runner <- getFixture @TestRunner+ runner.setMainFile [ "import Skeletest.Main" , "import Skeletest.Plugin" , ""@@ -22,18 +24,18 @@ , " pure result" , " }" ]- addTestFile runner "ExampleSpec.hs" $+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "import Skeletest" , "spec = it \"should run\" $ pure ()" ]- (stdout, _) <- expectSuccess $ runTests runner []+ (stdout, _) <- expectSuccess runner.runTests stdout `shouldSatisfy` P.matchesSnapshot describe "modifySpecRegistry" $ do integration . it "allows modifying specs" $ do- runner <- getFixture- setMainFile runner $+ runner <- getFixture @TestRunner+ runner.setMainFile [ "{-# LANGUAGE DisambiguateRecordFields #-}" , "{-# LANGUAGE LambdaCase #-}" , "{-# LANGUAGE NamedFieldPuns #-}"@@ -51,12 +53,12 @@ , " where" , " isValid = not . (\"SKIP\" `T.isPrefixOf`) . (.name)" ]- addTestFile runner "ExampleSpec.hs" $+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "import Skeletest" , "spec = do" , " it \"should run\" $ pure ()" , " it \"SKIP should not run\" $ failTest \"bad\"" ]- (stdout, _) <- expectSuccess $ runTests runner []+ (stdout, _) <- expectSuccess runner.runTests stdout `shouldSatisfy` P.matchesSnapshot
test/Skeletest/PredicateSpec.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# OPTIONS_GHC -Wno-type-defaults #-} module Skeletest.PredicateSpec (spec) where@@ -130,8 +131,8 @@ User "alice" (Just 10) `shouldSatisfy` (P.con $ User (P.eq "alice") (P.just (P.gt 0))) integration . it "shows a helpful failure message" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -143,13 +144,13 @@ , " User \"alice\" `shouldSatisfy` P.con User{name = P.eq \"\"}" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot integration . it "fails to compile with unknown record field" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -161,13 +162,12 @@ , " User \"alice\" `shouldSatisfy` P.con User{foo = P.eq \"\"}" ] - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests stderr `shouldSatisfy` P.matchesSnapshot integration . it "fails to compile with omitted positional fields" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -179,13 +179,12 @@ , " User \"alice\" (Just 1) `shouldSatisfy` P.con (User (P.eq \"\"))" ] - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests (normalizeConFailure . normalizeVars) stderr `shouldSatisfy` P.matchesSnapshot integration . it "fails to compile with non-constructor" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -195,13 +194,12 @@ , " \"\" `shouldSatisfy` P.con \"\"" ] - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests stderr `shouldSatisfy` P.matchesSnapshot integration . it "fails to compile when not applied to anything" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -211,13 +209,12 @@ , " \"\" `shouldSatisfy` P.con" ] - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests stderr `shouldSatisfy` P.matchesSnapshot integration . it "fails to compile when applied to multiple arguments" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -227,8 +224,7 @@ , " \"\" `shouldSatisfy` P.con 1 2" ] - (stdout, stderr) <- expectFailure $ runTests runner []- stdout `shouldBe` ""+ (_, stderr) <- expectFailure runner.runTests stderr `shouldSatisfy` P.matchesSnapshot describe "Numeric" $ do
test/Skeletest/PropSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ module Skeletest.PropSpec (spec) where import Skeletest@@ -10,8 +12,8 @@ spec = do describe "setDiscardLimit" $ do integration . it "sets discard limit" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -22,7 +24,7 @@ , " discard" ] - (stdout, stderr) <- expectFailure $ runTests runner []+ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot @@ -32,8 +34,8 @@ (read . show) P.=== (+ 1) `shouldNotSatisfy` P.isoWith (Gen.int $ Range.exponential 0 10000000) integration . it "shows a helpful failure message" $ do- runner <- getFixture- addTestFile runner "ExampleSpec.hs" $+ runner <- getFixture @TestRunner+ runner.addTestFile "ExampleSpec.hs" $ [ "module ExampleSpec (spec) where" , "" , "import Skeletest"@@ -48,6 +50,6 @@ , " (read . show) P.=== id `shouldNotSatisfy` P.isoWith (Gen.int $ Range.linear 0 10)" ] - (stdout, stderr) <- expectFailure $ runTests runner ["--seed=0:0"]+ (stdout, stderr) <- expectFailure $ runner.runTestsWith def{cliArgs = ["--seed=0:0"]} stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot
test/Skeletest/TestUtils/Integration.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -7,29 +9,29 @@ integration, -- * Test runner- FixtureTestRunner,+ TestRunner, FileContents,- setMainFile,- addTestFile,- readTestFile, -- * runTests- runTests,+ TestArgs (..), expectCode, expectSuccess, expectFailure, -- * Re-exports ExitCode (..),+ def, ) where +import Data.Default (Default (..)) import Data.IORef (IORef, modifyIORef, newIORef, readIORef) import Data.Text qualified as Text+import GHC.Records (HasField (..)) import Skeletest import System.Directory (createDirectoryIfMissing) import System.Exit (ExitCode (..)) import System.FilePath (takeDirectory, (</>))-import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode)+import System.Process qualified as Process data MarkerIntegration = MarkerIntegration deriving (Show)@@ -42,84 +44,106 @@ {----- runTests -----} -data FixtureTestRunner = FixtureTestRunner- { testRunnerDir :: FilePath- , testRunnerSettingsRef :: IORef TestRunnerSettings+data TestRunner = TestRunner+ { dir :: FilePath+ , settingsRef :: IORef TestRunnerSettings } data TestRunnerSettings = TestRunnerSettings- { mainFile :: FileContents+ { mainFileContents :: FileContents , testFiles :: [(FilePath, FileContents)] } -- | File contents as a list of lines. type FileContents = [String] -instance Fixture FixtureTestRunner where+instance Fixture TestRunner where fixtureAction = do- FixtureTmpDir tmpdir <- getFixture+ FixtureTmpDir dir <- getFixture settingsRef <- newIORef defaultSettings- pure . noCleanup $- FixtureTestRunner- { testRunnerDir = tmpdir- , testRunnerSettingsRef = settingsRef- }+ pure $ noCleanup TestRunner{..} where defaultSettings = TestRunnerSettings- { mainFile = ["import Skeletest.Main"]+ { mainFileContents = ["import Skeletest.Main"] , testFiles = [] } -setMainFile :: FixtureTestRunner -> FileContents -> IO ()-setMainFile FixtureTestRunner{testRunnerSettingsRef} contents =- modifyIORef testRunnerSettingsRef $ \settings -> settings{mainFile = contents}+instance HasField "setMainFile" TestRunner (FileContents -> IO ()) where+ getField runner contents =+ modifyIORef runner.settingsRef $ \settings ->+ settings{mainFileContents = contents} -addTestFile :: FixtureTestRunner -> FilePath -> FileContents -> IO ()-addTestFile FixtureTestRunner{testRunnerSettingsRef} fp contents =- modifyIORef testRunnerSettingsRef $ \settings ->- settings{testFiles = (fp, contents) : settings.testFiles}+instance HasField "addTestFile" TestRunner (FilePath -> FileContents -> IO ()) where+ getField runner fp contents =+ modifyIORef runner.settingsRef $ \settings ->+ settings{testFiles = (fp, contents) : settings.testFiles} -readTestFile :: FixtureTestRunner -> FilePath -> IO String-readTestFile FixtureTestRunner{testRunnerDir} fp = readFile $ testRunnerDir </> fp+instance HasField "readTestFile" TestRunner (FilePath -> IO String) where+ getField runner fp = readFile $ runner.dir </> fp -runTests :: FixtureTestRunner -> [String] -> IO (ExitCode, String, String)-runTests FixtureTestRunner{..} args = do- TestRunnerSettings{..} <- readIORef testRunnerSettingsRef- addFile "Main.hs" mainFile- mapM_ (uncurry addFile) testFiles+data TestArgs = TestArgs+ { cwd :: Maybe FilePath+ , cliArgs :: [String]+ , ghcArgs :: [String]+ , mainFile :: String+ } - (code, stdout, stderr) <-- flip readCreateProcessWithExitCode "" $- setCWD testRunnerDir . proc "runghc" . concat $- [ "--" : ghcArgs- , "--" : "Main.hs" : args- ]+instance Default TestArgs where+ def =+ TestArgs+ { cwd = Nothing+ , cliArgs = []+ , ghcArgs = []+ , mainFile = "Main.hs"+ } - pure (code, sanitize stdout, sanitize stderr)- where- addFile fp contents = do- let path = testRunnerDir </> fp- createDirectoryIfMissing True (takeDirectory path)- writeFile path (unlines contents)+instance HasField "runTests" TestRunner (IO (ExitCode, String, String)) where+ getField runner = runner.runTestsWith def - ghcArgs =- concat- [ ["-hide-all-packages"]- , ["-F", "-pgmF=skeletest-preprocessor"]- , ["-package skeletest"]- ]- setCWD dir p = p{cwd = Just dir}+instance HasField "runTestsWith" TestRunner (TestArgs -> IO (ExitCode, String, String)) where+ getField runner args = do+ settings <- readIORef runner.settingsRef+ addFile args.mainFile settings.mainFileContents+ mapM_ (uncurry addFile) settings.testFiles - sanitize = Text.unpack . stripOverwrites . stripControlChars . Text.strip . Text.pack- stripOverwrites s =- case Text.breakOn "\r" s of- (_, "") -> s- (pre, post) -> Text.dropWhileEnd (/= '\n') pre <> stripOverwrites (Text.drop 1 post)- stripControlChars s =- case Text.breakOn "\x1b" s of- (_, "") -> s- (pre, post) -> pre <> stripControlChars (Text.drop 1 . Text.dropWhile (/= 'm') $ post)+ let ghcArgs =+ concat+ [ ["-hide-all-packages"]+ , ["-F", "-pgmF=skeletest-preprocessor"]+ , ["-package skeletest"]+ , ["-o", "test-runner"]+ , args.ghcArgs+ , [args.mainFile]+ ]+ runProcWith id "ghc" ghcArgs >>= \case+ (ExitSuccess, _, _) ->+ runProcWith+ (maybe id setCWD args.cwd)+ (runner.dir </> "test-runner")+ args.cliArgs+ result -> pure result+ where+ addFile fp contents = do+ let path = runner.dir </> fp+ createDirectoryIfMissing True (takeDirectory path)+ writeFile path (unlines contents)++ setCWD dir p = p{Process.cwd = Just dir}+ runProcWith f cmd args_ = do+ let proc = f . setCWD runner.dir $ Process.proc cmd args_+ (code, stdout, stderr) <- Process.readCreateProcessWithExitCode proc ""+ pure (code, sanitize stdout, sanitize stderr)++ sanitize = Text.unpack . stripOverwrites . stripControlChars . Text.strip . Text.pack+ stripOverwrites s =+ case Text.breakOn "\r" s of+ (_, "") -> s+ (pre, post) -> Text.dropWhileEnd (/= '\n') pre <> stripOverwrites (Text.drop 1 post)+ stripControlChars s =+ case Text.breakOn "\x1b" s of+ (_, "") -> s+ (pre, post) -> pre <> stripControlChars (Text.drop 1 . Text.dropWhile (/= 'm') $ post) expectCode :: (HasCallStack) => ExitCode -> IO (ExitCode, String, String) -> IO (String, String) expectCode expected m = do
test/Skeletest/__snapshots__/AssertionsSpec.snap.md view
@@ -151,6 +151,20 @@ ╰─────────────────────────────────────────────────────────────────────────────── ``` +## shows source code when running from different directory++```+./ExampleSpec.hs+╭── should fail: FAIL+│ ./ExampleSpec.hs:3:+│ │+│ │ spec = it "should fail" $ failTest "failure"+│ │ ^^^^^^^^+│ +│ failure+╰───────────────────────────────────────────────────────────────────────────────+```+ ## shows unrecognized exceptions ```
test/Skeletest/__snapshots__/MainSpec.snap.md view
@@ -8,8 +8,6 @@ Main.hs:1:1: error: `skeletest-preprocessor' failed in phase `Haskell pre-processor'. (Exit code: 1)--*** Exception: ExitFailure 1 ``` ## errors if main function defined