sydtest-mutation-driver-gen (empty) → 0.0.0.0
raw patch · 15 files changed
+1402/−0 lines, 15 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, genvalidity, genvalidity-containers, genvalidity-path, genvalidity-sydtest, genvalidity-text, path, path-io, safe-coloured-text, sydtest, sydtest-mutation-driver, sydtest-mutation-driver-gen, sydtest-mutation-runtime, text
Files
- LICENSE.md +5/−0
- src/Test/Syd/Mutation/Driver/Gen.hs +36/−0
- sydtest-mutation-driver-gen.cabal +75/−0
- test/Spec.hs +1/−0
- test/Test/Syd/Mutation/Driver/AssertScoreSpec.hs +275/−0
- test/Test/Syd/Mutation/Driver/ComponentsSpec.hs +212/−0
- test/Test/Syd/Mutation/Driver/DiffRunSpec.hs +165/−0
- test/Test/Syd/Mutation/Driver/DiffSpec.hs +214/−0
- test/Test/Syd/Mutation/Driver/MutateSpec.hs +230/−0
- test/Test/Syd/Mutation/Driver/OptParseSpec.hs +50/−0
- test/Test/Syd/Mutation/Driver/SuitePkgSpec.hs +112/−0
- test_resources/diff-run/all-killed.golden +5/−0
- test_resources/diff-run/empty-selection.golden +5/−0
- test_resources/diff-run/one-survivor-fail.golden +12/−0
- test_resources/diff-run/one-uncovered-fail.golden +5/−0
+ LICENSE.md view
@@ -0,0 +1,5 @@+# Sydtest License++Copyright (c) 2025 Tom Sydney Kerckhove++See the Sydtest License at https://github.com/NorfairKing/sydtest/blob/master/sydtest/LICENSE.md for the full license text.
+ src/Test/Syd/Mutation/Driver/Gen.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | 'GenValid' instances for the sydtest-mutation-driver settings+-- types. Lives in a separate package so the generators aren't+-- compiled into the executable.+module Test.Syd.Mutation.Driver.Gen () where++import Data.GenValidity+import Data.GenValidity.Containers ()+import Data.GenValidity.Path ()+import Data.GenValidity.Text ()+import Test.Syd.Mutation.Driver.OptParse++instance Validity SuiteConfig++instance GenValid SuiteConfig++instance Validity SuitePkgSpec++instance GenValid SuitePkgSpec++instance Validity MutationDriverSettings++instance GenValid MutationDriverSettings++instance Validity CoverageSettings++instance GenValid CoverageSettings++instance Validity DiffSource++instance GenValid DiffSource++instance Validity DiffSettings++instance GenValid DiffSettings
+ sydtest-mutation-driver-gen.cabal view
@@ -0,0 +1,75 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.3.+--+-- see: https://github.com/sol/hpack++name: sydtest-mutation-driver-gen+version: 0.0.0.0+synopsis: Generators and tests for sydtest-mutation-driver's config types.+description: GenValid instances and roundtrip tests for the data types in sydtest-mutation-driver, ensuring the YAML/JSON encoding round-trips and that defaults are valid.+category: Testing+homepage: https://github.com/NorfairKing/sydtest#readme+bug-reports: https://github.com/NorfairKing/sydtest/issues+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+license: OtherLicense+license-file: LICENSE.md+build-type: Simple+extra-source-files:+ test_resources/diff-run/all-killed.golden+ test_resources/diff-run/empty-selection.golden+ test_resources/diff-run/one-survivor-fail.golden+ test_resources/diff-run/one-uncovered-fail.golden++source-repository head+ type: git+ location: https://github.com/NorfairKing/sydtest++library+ exposed-modules:+ Test.Syd.Mutation.Driver.Gen+ other-modules:+ Paths_sydtest_mutation_driver_gen+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , genvalidity+ , genvalidity-containers+ , genvalidity-path+ , genvalidity-text+ , sydtest-mutation-driver+ default-language: Haskell2010++test-suite sydtest-mutation-driver-gen-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.Syd.Mutation.Driver.AssertScoreSpec+ Test.Syd.Mutation.Driver.ComponentsSpec+ Test.Syd.Mutation.Driver.DiffRunSpec+ Test.Syd.Mutation.Driver.DiffSpec+ Test.Syd.Mutation.Driver.MutateSpec+ Test.Syd.Mutation.Driver.OptParseSpec+ Test.Syd.Mutation.Driver.SuitePkgSpec+ Paths_sydtest_mutation_driver_gen+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ sydtest-discover:sydtest-discover+ build-depends:+ base >=4.7 && <5+ , bytestring+ , containers+ , genvalidity-sydtest+ , path+ , path-io+ , safe-coloured-text+ , sydtest+ , sydtest-mutation-driver+ , sydtest-mutation-driver-gen+ , sydtest-mutation-runtime+ , text+ default-language: Haskell2010
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Test/Syd/Mutation/Driver/AssertScoreSpec.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Test.Syd.Mutation.Driver.AssertScoreSpec (spec) where++import qualified Control.Exception as Exception+import qualified Data.Text as T+import Path+import Path.IO (doesFileExist, withSystemTempDir)+import System.Exit (ExitCode (..))+import Test.Syd+import Test.Syd.Mutation.AugmentedManifest+ ( ControlTally (..),+ MutationRunReport (..),+ MutationTally (..),+ writeMutationRunReport,+ )+import Test.Syd.Mutation.Driver.AssertScore+ ( AssertScoreResult (..),+ assertScoreResult,+ runAssertScore,+ )+import Text.Colour (TerminalCapabilities (..), renderChunksText)++spec :: Spec+spec = do+ describe "runAssertScore" $ do+ it "symlinks report.{txt,json} into the out dir on success" $+ withSystemTempDir "assert-score-pass" $ \dir -> do+ let reportDir = dir </> [reldir|report|]+ outDir = dir </> [reldir|out|]+ report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 3,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ writeMutationRunReport reportDir report+ -- The Nix harness writes report.txt alongside report.json; we+ -- emulate that here so the symlink target exists.+ writeFile (fromAbsFile (reportDir </> [relfile|report.txt|])) "(rendered report)"+ runAssertScore True reportDir (Just outDir)+ txtCopied <- doesFileExist (outDir </> [relfile|report.txt|])+ jsonCopied <- doesFileExist (outDir </> [relfile|report.json|])+ txtCopied `shouldBe` True+ jsonCopied `shouldBe` True++ it "exits 1 on a failed assertion and does not symlink anything into the out dir" $+ withSystemTempDir "assert-score-fail" $ \dir -> do+ let reportDir = dir </> [reldir|report|]+ outDir = dir </> [reldir|out|]+ report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 3,+ mutationTallySurvived = 1,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ writeMutationRunReport reportDir report+ writeFile (fromAbsFile (reportDir </> [relfile|report.txt|])) "(rendered report)"+ result <-+ ( Exception.try ::+ IO () ->+ IO (Either ExitCode ())+ )+ $ runAssertScore True reportDir (Just outDir)+ result `shouldBe` Left (ExitFailure 1)+ -- The out dir should not exist (or should be empty) because+ -- the symlink step never ran.+ txtCopied <- doesFileExist (outDir </> [relfile|report.txt|])+ txtCopied `shouldBe` False++ it "exits 2 when report.json is missing" $+ withSystemTempDir "assert-score-missing" $ \dir -> do+ let reportDir = dir </> [reldir|empty|]+ result <-+ ( Exception.try ::+ IO () ->+ IO (Either ExitCode ())+ )+ $ runAssertScore True reportDir Nothing+ result `shouldBe` Left (ExitFailure 2)++ describe "assertScoreResult" $ do+ it "passes when nothing survived and nothing is uncovered" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 5,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ result = assertScoreResult True report+ assertScoreFailed result `shouldBe` False+ T.unpack (renderChunksText WithoutColours (assertScoreHeader result))+ `shouldBe` "PASS: All 5 mutation(s) accounted for."++ it "fails when one mutation survived" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 4,+ mutationTallySurvived = 1,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ result = assertScoreResult True report+ assertScoreFailed result `shouldBe` True+ T.unpack (renderChunksText WithoutColours (assertScoreHeader result))+ `shouldBe` "FAIL: 1 surviving, 0 uncovered out of 5 mutation(s)."++ it "fails when a control mutation was killed, even with nothing else wrong" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 5,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 2,+ controlTallyFailed = 1+ },+ mutationRunReportGroups = []+ }+ result = assertScoreResult True report+ assertScoreFailed result `shouldBe` True+ T.unpack (renderChunksText WithoutColours (assertScoreHeader result))+ `shouldBe` "FAIL: 0 surviving, 0 uncovered, 1 control failure(s) out of 5 mutation(s)."++ it "passes when controls all pass" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 5,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 3,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ assertScoreFailed (assertScoreResult True report) `shouldBe` False++ it "fails when one mutation is uncovered and assertion is enabled" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 4,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 1,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ assertScoreFailed (assertScoreResult True report) `shouldBe` True++ it "passes when one mutation is uncovered but the uncovered assertion is disabled" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 4,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 1,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ assertScoreFailed (assertScoreResult False report) `shouldBe` False++ it "still fails on survivors even when the uncovered assertion is disabled" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 4,+ mutationTallySurvived = 1,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ assertScoreFailed (assertScoreResult False report) `shouldBe` True++ it "counts killed + survived + uncovered (timed-out and skipped don't add to the total in the header)" $ do+ let report =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 3,+ mutationTallySurvived = 2,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 1,+ mutationTallySkipped = 99+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }+ result = assertScoreResult True report+ T.unpack (renderChunksText WithoutColours (assertScoreHeader result))+ `shouldBe` "FAIL: 2 surviving, 1 uncovered out of 6 mutation(s)."
+ test/Test/Syd/Mutation/Driver/ComponentsSpec.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Test.Syd.Mutation.Driver.ComponentsSpec (spec) where++import qualified Control.Exception as Exception+import qualified Data.ByteString as SB+import Path+import Path.IO (createDirIfMissing, doesFileExist, withSystemTempDir)+import Test.Syd+import Test.Syd.Mutation.Driver.Components+ ( CabalFileLookupError (..),+ MissingBuiltComponent (..),+ findCabalFile,+ readComponentNames,+ runInstallComponentsWithBuildDir,+ )+import Test.Syd.Mutation.Driver.OptParse (ComponentKind (..))++spec :: Spec+spec = do+ describe "readComponentNames" $ do+ it "returns executable names in declaration order" $+ withSystemTempDir "components-exes" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "executable first-exe\n",+ " main-is: Main.hs\n",+ " build-depends: base\n",+ "executable second-exe\n",+ " main-is: Main.hs\n",+ " build-depends: base\n"+ ]+ names <- readComponentNames ComponentExecutables cabalFile+ names `shouldBe` ["first-exe", "second-exe"]++ it "returns test-suite names" $+ withSystemTempDir "components-tests" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "test-suite the-test\n",+ " type: exitcode-stdio-1.0\n",+ " main-is: Spec.hs\n",+ " build-depends: base\n"+ ]+ names <- readComponentNames ComponentTestSuites cabalFile+ names `shouldBe` ["the-test"]++ it "returns an empty list when the package declares no components of that kind" $+ withSystemTempDir "components-empty" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "library\n",+ " build-depends: base\n"+ ]+ execNames <- readComponentNames ComponentExecutables cabalFile+ testNames <- readComponentNames ComponentTestSuites cabalFile+ execNames `shouldBe` []+ testNames `shouldBe` []++ describe "runInstallComponentsWithBuildDir" $ do+ it "copies each declared executable from <buildDir>/<n>/<n> to <outDir>/<n>" $+ withSystemTempDir "install-ok" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ buildDir = dir </> [reldir|dist/build|]+ outDir = dir </> [reldir|out|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "executable foo\n",+ " main-is: Main.hs\n",+ " build-depends: base\n",+ "executable bar\n",+ " main-is: Main.hs\n",+ " build-depends: base\n"+ ]+ createDirIfMissing True (buildDir </> [reldir|foo|])+ createDirIfMissing True (buildDir </> [reldir|bar|])+ SB.writeFile (fromAbsFile (buildDir </> [relfile|foo/foo|])) "FOO"+ SB.writeFile (fromAbsFile (buildDir </> [relfile|bar/bar|])) "BAR"+ runInstallComponentsWithBuildDir ComponentExecutables cabalFile buildDir outDir+ copiedFoo <- doesFileExist (outDir </> [relfile|foo|])+ copiedBar <- doesFileExist (outDir </> [relfile|bar|])+ copiedFoo `shouldBe` True+ copiedBar `shouldBe` True+ fooBytes <- SB.readFile (fromAbsFile (outDir </> [relfile|foo|]))+ fooBytes `shouldBe` "FOO"++ it "throws MissingBuiltComponent when a declared executable's binary is absent" $+ withSystemTempDir "install-missing" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ buildDir = dir </> [reldir|dist/build|]+ outDir = dir </> [reldir|out|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "executable foo\n",+ " main-is: Main.hs\n",+ " build-depends: base\n"+ ]+ result <-+ Exception.try $+ runInstallComponentsWithBuildDir ComponentExecutables cabalFile buildDir outDir+ case result of+ Left (MissingBuiltComponent name _) -> name `shouldBe` "foo"+ Right () -> expectationFailure "expected MissingBuiltComponent to be thrown"++ it "creates the output directory when it does not exist" $+ withSystemTempDir "install-mkdir" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ buildDir = dir </> [reldir|dist/build|]+ outDir = dir </> [reldir|nested/out|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "executable foo\n",+ " main-is: Main.hs\n",+ " build-depends: base\n"+ ]+ createDirIfMissing True (buildDir </> [reldir|foo|])+ SB.writeFile (fromAbsFile (buildDir </> [relfile|foo/foo|])) "FOO"+ runInstallComponentsWithBuildDir ComponentExecutables cabalFile buildDir outDir+ copied <- doesFileExist (outDir </> [relfile|foo|])+ copied `shouldBe` True++ it "is a no-op when the package declares no components of that kind" $+ withSystemTempDir "install-empty" $ \dir -> do+ let cabalFile = dir </> [relfile|pkg.cabal|]+ buildDir = dir </> [reldir|dist/build|]+ outDir = dir </> [reldir|out|]+ SB.writeFile (fromAbsFile cabalFile) $+ mconcat+ [ "cabal-version: 2.0\n",+ "name: pkg\n",+ "version: 0.1.0.0\n",+ "build-type: Simple\n",+ "library\n",+ " build-depends: base\n"+ ]+ -- Should not throw and should not need <buildDir> to exist.+ runInstallComponentsWithBuildDir ComponentExecutables cabalFile buildDir outDir++ describe "findCabalFile" $ do+ it "returns <pname>.cabal when it exists" $+ withSystemTempDir "find-preferred" $ \dir -> do+ let expected = dir </> [relfile|foo.cabal|]+ SB.writeFile (fromAbsFile expected) "cabal-version: 2.0\nname: foo\n"+ actual <- findCabalFile "foo" dir+ actual `shouldBe` expected++ it "prefers <pname>.cabal over a differently-named .cabal also in the directory" $+ withSystemTempDir "find-prefer-over-other" $ \dir -> do+ let expected = dir </> [relfile|foo.cabal|]+ SB.writeFile (fromAbsFile expected) "cabal-version: 2.0\nname: foo\n"+ SB.writeFile (fromAbsFile (dir </> [relfile|other.cabal|])) "cabal-version: 2.0\nname: other\n"+ actual <- findCabalFile "foo" dir+ actual `shouldBe` expected++ it "falls back to the single other .cabal file when <pname>.cabal is absent" $+ withSystemTempDir "find-fallback" $ \dir -> do+ let expected = dir </> [relfile|differently-named.cabal|]+ SB.writeFile (fromAbsFile expected) "cabal-version: 2.0\nname: x\n"+ actual <- findCabalFile "foo" dir+ actual `shouldBe` expected++ it "throws NoCabalFileFound when the directory has no .cabal files" $+ withSystemTempDir "find-empty" $ \dir -> do+ result <-+ (Exception.try :: IO (Path Abs File) -> IO (Either CabalFileLookupError (Path Abs File))) $+ findCabalFile "foo" dir+ case result of+ Left (NoCabalFileFound d) -> d `shouldBe` dir+ Left e -> expectationFailure ("wrong error: " ++ show e)+ Right p -> expectationFailure ("expected NoCabalFileFound, got " ++ show p)++ it "throws AmbiguousCabalFile when <pname>.cabal is absent and multiple other .cabal files match" $+ withSystemTempDir "find-ambiguous" $ \dir -> do+ SB.writeFile (fromAbsFile (dir </> [relfile|a.cabal|])) "cabal-version: 2.0\nname: a\n"+ SB.writeFile (fromAbsFile (dir </> [relfile|b.cabal|])) "cabal-version: 2.0\nname: b\n"+ result <-+ (Exception.try :: IO (Path Abs File) -> IO (Either CabalFileLookupError (Path Abs File))) $+ findCabalFile "foo" dir+ case result of+ Left (AmbiguousCabalFile d pname _) -> do+ d `shouldBe` dir+ pname `shouldBe` "foo"+ Left e -> expectationFailure ("wrong error: " ++ show e)+ Right p -> expectationFailure ("expected AmbiguousCabalFile, got " ++ show p)
+ test/Test/Syd/Mutation/Driver/DiffRunSpec.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Syd.Mutation.Driver.DiffRunSpec (spec) where++import qualified Data.Map.Strict as Map+import Test.Syd+import Test.Syd.Mutation.AugmentedManifest+ ( AugmentedMutationRecord (..),+ ControlTally (..),+ MutationGroupReport (..),+ MutationOutcome (..),+ MutationRunReport (..),+ MutationTally (..),+ SurvivedMutation (..),+ )+import Test.Syd.Mutation.Driver.AssertScore (assertScoreResult)+import Test.Syd.Mutation.Driver.DiffRun (renderDiffFinalSummary)+import Test.Syd.Mutation.Runtime (MutationId (..))+import Text.Colour (TerminalCapabilities (..), renderChunksText, unlinesChunks)++-- | These golden files capture the final block of the diff runner's+-- stdout — what the CI build log ends with after a diff-scoped mutation+-- run. Open one of the @.golden@ files in the review and you see the+-- exact PASS\/FAIL + report-paths block the user will see.+spec :: Spec+spec = describe "renderDiffFinalSummary" $ do+ it "renders an empty-selection PASS block" $+ pureGoldenTextFile+ "test_resources/diff-run/empty-selection.golden"+ (renderColoured numSelected reportAllZero)++ it "renders an all-killed PASS block" $+ pureGoldenTextFile+ "test_resources/diff-run/all-killed.golden"+ (renderColoured 3 reportAllKilled)++ it "renders a FAIL block with one survivor" $+ pureGoldenTextFile+ "test_resources/diff-run/one-survivor-fail.golden"+ (renderColoured 3 reportOneSurvivor)++ it "renders a FAIL block with one uncovered mutation" $+ pureGoldenTextFile+ "test_resources/diff-run/one-uncovered-fail.golden"+ (renderColoured 3 reportOneUncovered)+ where+ numSelected = 0++ reportAllZero =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 0,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }++ reportAllKilled =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 3,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }++ reportOneSurvivor =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 2,+ mutationTallySurvived = 1,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 0,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups =+ [ MutationGroupReport+ { mutationGroupReportOutcomes =+ [OutcomeSurvived survivor]+ }+ ]+ }++ survivor =+ SurvivedMutation+ { survivedMutationRecord = survivorRecord,+ survivedMutationLogFile = Nothing+ }++ survivorRecord =+ AugmentedMutationRecord+ { augmentedMutationRecordId =+ MutationId ["Example.Lib", "BoolLit", "12", "8", "12"],+ augmentedMutationRecordOperator = "BoolLit",+ augmentedMutationRecordOriginal = "True",+ augmentedMutationRecordReplacement = "False",+ augmentedMutationRecordModule = "Example.Lib",+ augmentedMutationRecordLine = 12,+ augmentedMutationRecordEndLine = 12,+ augmentedMutationRecordColStart = 8,+ augmentedMutationRecordColEnd = 12,+ augmentedMutationRecordSourceFile = Nothing,+ augmentedMutationRecordSourceLines = [],+ augmentedMutationRecordMutatedLines = [],+ augmentedMutationRecordContextBefore = [],+ augmentedMutationRecordContextAfter = [],+ augmentedMutationRecordCoveringTests = Map.empty,+ augmentedMutationRecordTimeoutMicros = 30000000,+ augmentedMutationRecordBinding = Nothing,+ augmentedMutationRecordMitigation = Nothing+ }++ reportOneUncovered =+ MutationRunReport+ { mutationRunReportMutations =+ MutationTally+ { mutationTallyKilled = 2,+ mutationTallySurvived = 0,+ mutationTallyTimedOut = 0,+ mutationTallyUncovered = 1,+ mutationTallySkipped = 0+ },+ mutationRunReportControls =+ ControlTally+ { controlTallyPassed = 0,+ controlTallyFailed = 0+ },+ mutationRunReportGroups = []+ }++ -- Fixed paths so the golden files don't drift with tmp dir names.+ txtPath = "/run/report.txt"+ jsonPath = "/run/report.json"++ -- Render with full 24-bit colour capability so the goldens capture+ -- the exact ANSI escape sequences a reviewer would see in their+ -- terminal — not the colour-stripped version.+ renderColoured n report =+ let assertion = assertScoreResult True report+ chunks = renderDiffFinalSummary n assertion report txtPath jsonPath+ in renderChunksText With24BitColours (unlinesChunks chunks)
+ test/Test/Syd/Mutation/Driver/DiffSpec.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Test.Syd.Mutation.Driver.DiffSpec (spec) where++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T+import Path+import Test.Syd+import Test.Syd.Mutation.AugmentedManifest+ ( AugmentedManifest (..),+ AugmentedMutationGroup (..),+ AugmentedMutationRecord (..),+ )+import Test.Syd.Mutation.Driver.Diff+import Test.Syd.Mutation.Runtime (MutationId (..))+import Test.Syd.Mutation.TestId (TestId, parseTestIdFilterArg)++-- | Build an augmented record with the fields the diff selection looks at;+-- the rest are filler.+mkRecord ::+ -- | id+ [String] ->+ -- | source file (package-relative)+ Maybe (Path Rel File) ->+ -- | (line, end_line)+ (Word, Word) ->+ -- | covering tests, by suite+ Map.Map Text [TestId] ->+ AugmentedMutationRecord+mkRecord idParts mSrc (line, endLine) covering =+ AugmentedMutationRecord+ { augmentedMutationRecordId = MutationId idParts,+ augmentedMutationRecordOperator = "Op",+ augmentedMutationRecordOriginal = "+",+ augmentedMutationRecordReplacement = "-",+ augmentedMutationRecordModule = "M",+ augmentedMutationRecordLine = line,+ augmentedMutationRecordEndLine = endLine,+ augmentedMutationRecordColStart = 1,+ augmentedMutationRecordColEnd = 2,+ augmentedMutationRecordSourceFile = mSrc,+ augmentedMutationRecordSourceLines = [],+ augmentedMutationRecordMutatedLines = [],+ augmentedMutationRecordContextBefore = [],+ augmentedMutationRecordContextAfter = [],+ augmentedMutationRecordCoveringTests = covering,+ augmentedMutationRecordTimeoutMicros = 30000000,+ augmentedMutationRecordBinding = Nothing,+ augmentedMutationRecordMitigation = Nothing+ }++tid :: Text -> TestId+tid t = case parseTestIdFilterArg t of+ Just i -> i+ Nothing -> error ("DiffSpec: unparseable test id in test fixture: " ++ T.unpack t)++-- | A hunk over @[s..e]@ where the whole span is also the added range — the+-- common "all lines in this range were added" fixture.+addedHunk :: Path Rel File -> Word -> Word -> DiffHunk+addedHunk file s e =+ DiffHunk+ { diffHunkFile = file,+ diffHunkSpanStart = s,+ diffHunkSpanEnd = e,+ diffHunkAddedRanges = [(s, e)]+ }++spec :: Spec+spec = do+ describe "parseUnifiedDiff" $ do+ it "parses a single-file single-hunk added run" $ do+ let d =+ T.unlines+ [ "diff --git a/sydtest-mutation-example/src/Example/Lib.hs b/sydtest-mutation-example/src/Example/Lib.hs",+ "index abc..def 100644",+ "--- a/sydtest-mutation-example/src/Example/Lib.hs",+ "+++ b/sydtest-mutation-example/src/Example/Lib.hs",+ "@@ -8,3 +8,4 @@ addOne x =",+ " context line",+ "+added line one",+ "+added line two",+ " more context"+ ]+ parseUnifiedDiff d+ `shouldBe` Right+ [ DiffHunk+ { diffHunkFile = [relfile|sydtest-mutation-example/src/Example/Lib.hs|],+ diffHunkSpanStart = 8,+ diffHunkSpanEnd = 11,+ diffHunkAddedRanges = [(9, 10)]+ }+ ]++ it "records separate added runs within one hunk" $ do+ let d =+ T.unlines+ [ "+++ b/A.hs",+ "@@ -1,5 +1,7 @@",+ " a",+ "+b",+ " c",+ "+d",+ "+e",+ " f"+ ]+ parseUnifiedDiff d+ `shouldBe` Right+ [ DiffHunk+ { diffHunkFile = [relfile|A.hs|],+ -- 6 new-side lines in the body: a,b,c,d,e,f.+ diffHunkSpanStart = 1,+ diffHunkSpanEnd = 6,+ diffHunkAddedRanges = [(2, 2), (4, 5)]+ }+ ]++ it "advances new-side line numbers past context but not deletions" $ do+ let d =+ T.unlines+ [ "+++ b/A.hs",+ "@@ -1,4 +1,4 @@",+ " a",+ "-removed",+ "+replacement",+ " b"+ ]+ -- new-side: line 1 = 'a' (context), line 2 = 'replacement' (added),+ -- line 3 = 'b' (context). The deletion does not advance the counter.+ parseUnifiedDiff d+ `shouldBe` Right+ [ DiffHunk+ { diffHunkFile = [relfile|A.hs|],+ diffHunkSpanStart = 1,+ diffHunkSpanEnd = 3,+ diffHunkAddedRanges = [(2, 2)]+ }+ ]++ it "skips /dev/null new-side files (deletions)" $ do+ let d =+ T.unlines+ [ "+++ /dev/null",+ "@@ -1,2 +0,0 @@",+ "-gone one",+ "-gone two"+ ]+ parseUnifiedDiff d `shouldBe` Right []++ describe "pathMatchesHunkFile" $ do+ it "matches when the package-relative path is a component suffix of the diff path" $+ pathMatchesHunkFile+ [relfile|src/Example/Lib.hs|]+ [relfile|sydtest-mutation-example/src/Example/Lib.hs|]+ `shouldBe` True+ it "does not match on a partial last-component overlap" $+ pathMatchesHunkFile+ [relfile|b/Lib.hs|]+ [relfile|ab/Lib.hs|]+ `shouldBe` False+ it "matches an exact equal path" $+ pathMatchesHunkFile [relfile|src/A.hs|] [relfile|src/A.hs|] `shouldBe` True++ describe "mutationsInHunks" $ do+ let recA = mkRecord ["M", "Op", "10"] (Just [relfile|src/A.hs|]) (10, 10) Map.empty+ recB = mkRecord ["M", "Op", "20"] (Just [relfile|src/A.hs|]) (20, 22) Map.empty+ recOther = mkRecord ["N", "Op", "5"] (Just [relfile|src/B.hs|]) (5, 5) Map.empty+ manifest = AugmentedManifest [AugmentedMutationGroup [recA, recB, recOther]]+ it "selects only mutations whose span intersects a hunk in a matching file" $ do+ let hunks = [addedHunk [relfile|pkg/src/A.hs|] 9 11]+ mutationsInHunks hunks manifest+ `shouldBe` Set.singleton (MutationId ["M", "Op", "10"])+ it "selects a multi-line span when the hunk overlaps its end" $ do+ let hunks = [addedHunk [relfile|pkg/src/A.hs|] 21 21]+ mutationsInHunks hunks manifest+ `shouldBe` Set.singleton (MutationId ["M", "Op", "20"])+ it "selects nothing when the hunk is in an unrelated file" $+ mutationsInHunks [addedHunk [relfile|pkg/src/C.hs|] 1 100] manifest+ `shouldBe` Set.empty++ describe "testsInHunks" $ do+ let locs =+ Map.fromList+ [ (tid "Spec.one", ([relfile|test/Spec.hs|], 5)),+ (tid "Spec.two", ([relfile|test/Spec.hs|], 9))+ ]+ it "selects tests whose source line falls in a hunk" $+ testsInHunks [addedHunk [relfile|pkg/test/Spec.hs|] 8 10] locs+ `shouldBe` Set.singleton (tid "Spec.two")++ describe "selectMutations" $+ it "unions source-selected and test-covered mutations" $ do+ let srcRec = mkRecord ["M", "Op", "10"] (Just [relfile|src/A.hs|]) (10, 10) Map.empty+ covRec =+ mkRecord+ ["M", "Op", "99"]+ (Just [relfile|src/A.hs|])+ (99, 99)+ (Map.singleton "" [tid "Spec.two"])+ manifest = AugmentedManifest [AugmentedMutationGroup [srcRec, covRec]]+ locs = Map.singleton "" (Map.fromList [(tid "Spec.two", ([relfile|test/Spec.hs|], 9))])+ -- One hunk touches the source line 10; another touches the test+ -- line 9 (whose test covers mutation 99).+ hunks =+ [ addedHunk [relfile|pkg/src/A.hs|] 10 10,+ addedHunk [relfile|pkg/test/Spec.hs|] 9 9+ ]+ selectMutations hunks manifest locs+ `shouldBe` Set.fromList+ [ MutationId ["M", "Op", "10"],+ MutationId ["M", "Op", "99"]+ ]
+ test/Test/Syd/Mutation/Driver/MutateSpec.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Test.Syd.Mutation.Driver.MutateSpec (spec) where++import qualified Control.Exception as Exception+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Map.Strict as Map+import Path (fromAbsFile, parseAbsDir, relfile, (</>))+import Path.IO (canonicalizePath, getPermissions, setOwnerExecutable, setPermissions, withSystemTempDir)+import Test.Syd+import Test.Syd.Mutation.AugmentedManifest+ ( AugmentedManifest (..),+ AugmentedMutationGroup (..),+ AugmentedMutationRecord (..),+ ControlTally (..),+ MutationRunReport (..),+ MutationTally (..),+ writeAugmentedManifestFile,+ )+import Test.Syd.Mutation.Driver.Mutate (UnknownCoveringSuite (..), runMutationMode)+import Test.Syd.Mutation.Driver.OptParse (SuiteConfig (..))+import Test.Syd.Mutation.Manifest (controlOperatorName)+import Test.Syd.Mutation.Runtime (MutationId (..))+import Test.Syd.Mutation.TestId (TestId (..))++spec :: Spec+spec = describe "runMutationMode" $ do+ it "runs each mutation child in its suite's resource directory" $+ -- Regression test: the diff runner used to spawn mutation children+ -- with no working directory, so they ran in the invocation dir instead+ -- of the suite's resource dir that the coverage phase recorded covering+ -- tests against — producing false survivors. Here a stand-in suite exe+ -- records its working directory; it must equal the configured resource+ -- dir, not the test process's own working dir.+ withSystemTempDir "mutate-resdir-manifest" $ \manifestDir ->+ withSystemTempDir "mutate-resdir-out" $ \outDir ->+ withSystemTempDir "mutate-resdir-res" $ \resourceDir -> do+ let cwdFile = manifestDir </> [relfile|child-cwd.txt|]+ exeFile = manifestDir </> [relfile|suite-exe|]+ -- A suite exe that ignores the driver's args, records its working+ -- directory, and exits 0 (so the mutation "survives").+ writeFile+ (fromAbsFile exeFile)+ (unlines ["#!/bin/sh", "pwd -P > '" ++ fromAbsFile cwdFile ++ "'", "exit 0"])+ perms <- getPermissions exeFile+ setPermissions exeFile (setOwnerExecutable True perms)+ let record =+ AugmentedMutationRecord+ { augmentedMutationRecordId = MutationId ["M", "Op", "1", "1", "2"],+ augmentedMutationRecordOperator = "Op",+ augmentedMutationRecordOriginal = "+",+ augmentedMutationRecordReplacement = "-",+ augmentedMutationRecordModule = "M",+ augmentedMutationRecordLine = 1,+ augmentedMutationRecordEndLine = 1,+ augmentedMutationRecordColStart = 1,+ augmentedMutationRecordColEnd = 2,+ augmentedMutationRecordSourceFile = Nothing,+ augmentedMutationRecordSourceLines = [],+ augmentedMutationRecordMutatedLines = [],+ augmentedMutationRecordContextBefore = [],+ augmentedMutationRecordContextAfter = [],+ augmentedMutationRecordCoveringTests =+ Map.singleton "suite" [TestId (("t", 0) :| [])],+ augmentedMutationRecordTimeoutMicros = 30000000,+ augmentedMutationRecordBinding = Nothing,+ augmentedMutationRecordMitigation = Nothing+ }+ writeAugmentedManifestFile+ manifestDir+ (AugmentedManifest [AugmentedMutationGroup [record]])+ _ <-+ runMutationMode+ False+ False+ manifestDir+ outDir+ Nothing+ Nothing+ ( Map.singleton+ "suite"+ SuiteConfig+ { suiteConfigExe = exeFile,+ suiteConfigResourceDir = Just resourceDir+ }+ )+ recorded <- readFile (fromAbsFile cwdFile)+ recordedDir <- parseAbsDir (takeWhile (/= '\n') recorded)+ canonRecorded <- canonicalizePath recordedDir+ canonResource <- canonicalizePath resourceDir+ canonRecorded `shouldBe` canonResource++ it "throws UnknownCoveringSuite when the manifest references a suite not in suiteExes" $+ withSystemTempDir "mutate-spec" $ \dir -> do+ let record =+ AugmentedMutationRecord+ { augmentedMutationRecordId = MutationId ["M", "Op", "1", "1", "2"],+ augmentedMutationRecordOperator = "Op",+ augmentedMutationRecordOriginal = "+",+ augmentedMutationRecordReplacement = "-",+ augmentedMutationRecordModule = "M",+ augmentedMutationRecordLine = 1,+ augmentedMutationRecordEndLine = 1,+ augmentedMutationRecordColStart = 1,+ augmentedMutationRecordColEnd = 2,+ augmentedMutationRecordSourceFile = Nothing,+ augmentedMutationRecordSourceLines = [],+ augmentedMutationRecordMutatedLines = [],+ augmentedMutationRecordContextBefore = [],+ augmentedMutationRecordContextAfter = [],+ augmentedMutationRecordCoveringTests = Map.singleton "absent-suite" [],+ augmentedMutationRecordTimeoutMicros = 30000000,+ augmentedMutationRecordBinding = Nothing,+ augmentedMutationRecordMitigation = Nothing+ }+ writeAugmentedManifestFile+ dir+ (AugmentedManifest [AugmentedMutationGroup [record]])+ result <-+ Exception.try $+ runMutationMode False False dir dir Nothing Nothing Map.empty+ case result of+ Left (UnknownCoveringSuite name _) -> name `shouldBe` "absent-suite"+ Right _ -> expectationFailure "expected UnknownCoveringSuite to be thrown"++ it "reports a surviving control mutation as a passed control, excluded from the score" $+ -- A control (no-op) mutation is expected to survive. Survival means the+ -- control passed, so it must NOT be counted as a surviving real mutation,+ -- and (with fail-fast on) it must NOT trip fail-fast and abort the run.+ withSystemTempDir "control-pass-manifest" $ \manifestDir ->+ withSystemTempDir "control-pass-out" $ \outDir -> do+ let exeFile = manifestDir </> [relfile|suite-exe|]+ writeFile (fromAbsFile exeFile) (unlines ["#!/bin/sh", "exit 0"])+ perms <- getPermissions exeFile+ setPermissions exeFile (setOwnerExecutable True perms)+ let record =+ AugmentedMutationRecord+ { augmentedMutationRecordId = MutationId ["M", "Control", "1", "1", "2", "no-op", "0"],+ augmentedMutationRecordOperator = controlOperatorName,+ augmentedMutationRecordOriginal = "no-op",+ augmentedMutationRecordReplacement = "no-op",+ augmentedMutationRecordModule = "M",+ augmentedMutationRecordLine = 1,+ augmentedMutationRecordEndLine = 1,+ augmentedMutationRecordColStart = 1,+ augmentedMutationRecordColEnd = 2,+ augmentedMutationRecordSourceFile = Nothing,+ augmentedMutationRecordSourceLines = [],+ augmentedMutationRecordMutatedLines = [],+ augmentedMutationRecordContextBefore = [],+ augmentedMutationRecordContextAfter = [],+ augmentedMutationRecordCoveringTests =+ Map.singleton "suite" [TestId (("t", 0) :| [])],+ augmentedMutationRecordTimeoutMicros = 30000000,+ augmentedMutationRecordBinding = Nothing,+ augmentedMutationRecordMitigation = Nothing+ }+ writeAugmentedManifestFile+ manifestDir+ (AugmentedManifest [AugmentedMutationGroup [record]])+ report <-+ runMutationMode+ True+ False+ manifestDir+ outDir+ Nothing+ Nothing+ ( Map.singleton+ "suite"+ SuiteConfig {suiteConfigExe = exeFile, suiteConfigResourceDir = Nothing}+ )+ controlTallyPassed (mutationRunReportControls report) `shouldBe` 1+ controlTallyFailed (mutationRunReportControls report) `shouldBe` 0+ mutationTallySurvived (mutationRunReportMutations report) `shouldBe` 0+ mutationTallyKilled (mutationRunReportMutations report) `shouldBe` 0++ it "records a killed control as a failed control, separate from the kill score" $+ -- A killed control means the suite is unsound (flaky/nondeterministic) or+ -- the harness is buggy. It is recorded as a failed control (not a kill);+ -- a failed control fails the run, but runMutationMode itself still returns+ -- the report so the caller can decide the exit code.+ withSystemTempDir "control-fail-manifest" $ \manifestDir ->+ withSystemTempDir "control-fail-out" $ \outDir -> do+ let exeFile = manifestDir </> [relfile|suite-exe|]+ writeFile (fromAbsFile exeFile) (unlines ["#!/bin/sh", "exit 1"])+ perms <- getPermissions exeFile+ setPermissions exeFile (setOwnerExecutable True perms)+ let record =+ AugmentedMutationRecord+ { augmentedMutationRecordId = MutationId ["M", "Control", "1", "1", "2", "no-op", "0"],+ augmentedMutationRecordOperator = controlOperatorName,+ augmentedMutationRecordOriginal = "no-op",+ augmentedMutationRecordReplacement = "no-op",+ augmentedMutationRecordModule = "M",+ augmentedMutationRecordLine = 1,+ augmentedMutationRecordEndLine = 1,+ augmentedMutationRecordColStart = 1,+ augmentedMutationRecordColEnd = 2,+ augmentedMutationRecordSourceFile = Nothing,+ augmentedMutationRecordSourceLines = [],+ augmentedMutationRecordMutatedLines = [],+ augmentedMutationRecordContextBefore = [],+ augmentedMutationRecordContextAfter = [],+ augmentedMutationRecordCoveringTests =+ Map.singleton "suite" [TestId (("t", 0) :| [])],+ augmentedMutationRecordTimeoutMicros = 30000000,+ augmentedMutationRecordBinding = Nothing,+ augmentedMutationRecordMitigation = Nothing+ }+ writeAugmentedManifestFile+ manifestDir+ (AugmentedManifest [AugmentedMutationGroup [record]])+ report <-+ runMutationMode+ True+ False+ manifestDir+ outDir+ Nothing+ Nothing+ ( Map.singleton+ "suite"+ SuiteConfig {suiteConfigExe = exeFile, suiteConfigResourceDir = Nothing}+ )+ controlTallyFailed (mutationRunReportControls report) `shouldBe` 1+ controlTallyPassed (mutationRunReportControls report) `shouldBe` 0+ mutationTallyKilled (mutationRunReportMutations report) `shouldBe` 0+ mutationTallySurvived (mutationRunReportMutations report) `shouldBe` 0
+ test/Test/Syd/Mutation/Driver/OptParseSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Mutation.Driver.OptParseSpec (spec) where++import Test.Syd+import Test.Syd.Mutation.Driver.Gen ()+import Test.Syd.Mutation.Driver.OptParse+import Test.Syd.Validity++spec :: Spec+spec = do+ describe "SuiteConfig" $+ genValidSpec @SuiteConfig++ describe "SuitePkgSpec" $+ genValidSpec @SuitePkgSpec++ describe "MutationDriverSettings" $+ genValidSpec @MutationDriverSettings++ describe "CoverageSettings" $+ genValidSpec @CoverageSettings++ describe "DiffSource" $+ genValidSpec @DiffSource++ describe "DiffSettings" $+ genValidSpec @DiffSettings++ describe "parseSuitePkgSpec" $ do+ it "parses PNAME=ROOT=RESOURCE_DIR" $+ parseSuitePkgSpec "mypkg=/nix/store/abc/=/nix/store/def/"+ `shouldSatisfy` (\case Right _ -> True; Left _ -> False)+ it "rejects an empty PNAME" $+ parseSuitePkgSpec "=/nix/store/abc/=/nix/store/def/"+ `shouldSatisfy` (\case Left _ -> True; Right _ -> False)+ it "rejects when fewer than three components" $+ parseSuitePkgSpec "mypkg=/nix/store/abc/"+ `shouldSatisfy` (\case Left _ -> True; Right _ -> False)+ it "rejects when more than three components" $+ parseSuitePkgSpec "a=/b/=/c/=extra"+ `shouldSatisfy` (\case Left _ -> True; Right _ -> False)+ it "rejects a relative path for the built-test-pkg root" $+ parseSuitePkgSpec "mypkg=relative/path=/nix/store/def/"+ `shouldSatisfy` (\case Left _ -> True; Right _ -> False)+ it "rejects a relative path for the resource dir" $+ parseSuitePkgSpec "mypkg=/nix/store/abc/=relative/path"+ `shouldSatisfy` (\case Left _ -> True; Right _ -> False)
+ test/Test/Syd/Mutation/Driver/SuitePkgSpec.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Test.Syd.Mutation.Driver.SuitePkgSpec (spec) where++import qualified Control.Exception as Exception+import qualified Data.ByteString as SB+import qualified Data.Map.Strict as Map+import Path+import Path.IO (createDirIfMissing, withSystemTempDir)+import Test.Syd+import Test.Syd.Mutation.Driver.OptParse (SuiteConfig (..), SuitePkgSpec (..))+import Test.Syd.Mutation.Driver.SuitePkg (SuitePkgWalkError (..), walkSuitePkgs)++spec :: Spec+spec = describe "walkSuitePkgs" $ do+ it "expands one spec into one SuiteConfig per file under <root>/test" $+ withSystemTempDir "walk-one" $ \dir -> do+ let root = dir </> [reldir|pkg|]+ rd = dir </> [reldir|resource|]+ testDir = root </> [reldir|test|]+ createDirIfMissing True testDir+ createDirIfMissing True rd+ SB.writeFile (fromAbsFile (testDir </> [relfile|first-test|])) ""+ SB.writeFile (fromAbsFile (testDir </> [relfile|second-test|])) ""+ result <-+ walkSuitePkgs+ [ SuitePkgSpec+ { suitePkgSpecPname = "mypkg",+ suitePkgSpecBuiltTestPkgRoot = root,+ suitePkgSpecResourceDir = rd+ }+ ]+ Map.keys result `shouldBe` ["first-test", "second-test"]+ let firstSc = result Map.! "first-test"+ suiteConfigResourceDir firstSc `shouldBe` Just rd++ it "throws NoSuitesDeclared when every spec has an empty <root>/test" $+ withSystemTempDir "walk-empty" $ \dir -> do+ let root = dir </> [reldir|pkg|]+ rd = dir </> [reldir|resource|]+ createDirIfMissing True (root </> [reldir|test|])+ createDirIfMissing True rd+ result <-+ ( Exception.try ::+ IO (Map.Map a SuiteConfig) ->+ IO (Either SuitePkgWalkError (Map.Map a SuiteConfig))+ )+ $ walkSuitePkgs+ [ SuitePkgSpec+ { suitePkgSpecPname = "mypkg",+ suitePkgSpecBuiltTestPkgRoot = root,+ suitePkgSpecResourceDir = rd+ }+ ]+ case result of+ Left NoSuitesDeclared -> pure ()+ Left other -> expectationFailure ("wrong error: " ++ show other)+ Right m -> expectationFailure ("expected NoSuitesDeclared, got " ++ show (Map.keys m))++ it "throws NoSuitesDeclared when no specs are given" $ do+ result <-+ ( Exception.try ::+ IO (Map.Map a SuiteConfig) ->+ IO (Either SuitePkgWalkError (Map.Map a SuiteConfig))+ )+ $ walkSuitePkgs []+ case result of+ Left NoSuitesDeclared -> pure ()+ Left other -> expectationFailure ("wrong error: " ++ show other)+ Right m -> expectationFailure ("expected NoSuitesDeclared, got " ++ show (Map.keys m))++ it "silently ignores specs whose <root>/test directory does not exist" $+ withSystemTempDir "walk-missing-testdir" $ \dir -> do+ let rootA = dir </> [reldir|pkg-a|]+ rootB = dir </> [reldir|pkg-b|]+ rd = dir </> [reldir|resource|]+ createDirIfMissing True rootA -- no 'test' subdir+ createDirIfMissing True (rootB </> [reldir|test|])+ createDirIfMissing True rd+ SB.writeFile (fromAbsFile (rootB </> [relfile|test/only|])) ""+ result <-+ walkSuitePkgs+ [ SuitePkgSpec "a" rootA rd,+ SuitePkgSpec "b" rootB rd+ ]+ Map.keys result `shouldBe` ["only"]++ it "throws DuplicateSuiteName when two specs produce the same key" $+ withSystemTempDir "walk-dup" $ \dir -> do+ let rootA = dir </> [reldir|pkg-a|]+ rootB = dir </> [reldir|pkg-b|]+ rd = dir </> [reldir|resource|]+ createDirIfMissing True (rootA </> [reldir|test|])+ createDirIfMissing True (rootB </> [reldir|test|])+ createDirIfMissing True rd+ SB.writeFile (fromAbsFile (rootA </> [relfile|test/clash|])) ""+ SB.writeFile (fromAbsFile (rootB </> [relfile|test/clash|])) ""+ result <-+ ( Exception.try ::+ IO (Map.Map a SuiteConfig) ->+ IO (Either SuitePkgWalkError (Map.Map a SuiteConfig))+ )+ $ walkSuitePkgs+ [ SuitePkgSpec "a" rootA rd,+ SuitePkgSpec "b" rootB rd+ ]+ case result of+ Left (DuplicateSuiteName name) -> name `shouldBe` "clash"+ Left other -> expectationFailure ("wrong error: " ++ show other)+ Right m -> expectationFailure ("expected DuplicateSuiteName, got " ++ show (Map.keys m))
+ test_resources/diff-run/all-killed.golden view
@@ -0,0 +1,5 @@++[32mPASS: [mAll 3 mutation(s) accounted for.++Full report: /run/report.txt+Machine-readable report: /run/report.json
+ test_resources/diff-run/empty-selection.golden view
@@ -0,0 +1,5 @@++[32mPASS: [mnothing to mutation-test in this diff.++Full report: /run/report.txt+Machine-readable report: /run/report.json
+ test_resources/diff-run/one-survivor-fail.golden view
@@ -0,0 +1,12 @@++[31mFAIL: [m[31m1[m surviving, [32m0[m uncovered out of 3 mutation(s).++[31mSurviving mutations:[m++BoolLit at Example/Lib.hs:12:8-12+[31m - True[m+[32m + False[m+ disable: add [33mBoolLit[m to disabled-mutations in the plugin config++Full report: /run/report.txt+Machine-readable report: /run/report.json
+ test_resources/diff-run/one-uncovered-fail.golden view
@@ -0,0 +1,5 @@++[31mFAIL: [m[32m0[m surviving, [31m1[m uncovered out of 3 mutation(s).++Full report: /run/report.txt+Machine-readable report: /run/report.json