diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -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. diff --git a/src/Test/Syd/Mutation/Driver/Gen.hs b/src/Test/Syd/Mutation/Driver/Gen.hs new file mode 100644 --- /dev/null +++ b/src/Test/Syd/Mutation/Driver/Gen.hs @@ -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 diff --git a/sydtest-mutation-driver-gen.cabal b/sydtest-mutation-driver-gen.cabal new file mode 100644 --- /dev/null +++ b/sydtest-mutation-driver-gen.cabal @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF sydtest-discover #-} diff --git a/test/Test/Syd/Mutation/Driver/AssertScoreSpec.hs b/test/Test/Syd/Mutation/Driver/AssertScoreSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/AssertScoreSpec.hs @@ -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)." diff --git a/test/Test/Syd/Mutation/Driver/ComponentsSpec.hs b/test/Test/Syd/Mutation/Driver/ComponentsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/ComponentsSpec.hs @@ -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 // to /" $ + 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 to exist. + runInstallComponentsWithBuildDir ComponentExecutables cabalFile buildDir outDir + + describe "findCabalFile" $ do + it "returns .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 .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 .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 .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) diff --git a/test/Test/Syd/Mutation/Driver/DiffRunSpec.hs b/test/Test/Syd/Mutation/Driver/DiffRunSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/DiffRunSpec.hs @@ -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) diff --git a/test/Test/Syd/Mutation/Driver/DiffSpec.hs b/test/Test/Syd/Mutation/Driver/DiffSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/DiffSpec.hs @@ -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"] + ] diff --git a/test/Test/Syd/Mutation/Driver/MutateSpec.hs b/test/Test/Syd/Mutation/Driver/MutateSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/MutateSpec.hs @@ -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 diff --git a/test/Test/Syd/Mutation/Driver/OptParseSpec.hs b/test/Test/Syd/Mutation/Driver/OptParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/OptParseSpec.hs @@ -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) diff --git a/test/Test/Syd/Mutation/Driver/SuitePkgSpec.hs b/test/Test/Syd/Mutation/Driver/SuitePkgSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/Mutation/Driver/SuitePkgSpec.hs @@ -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 /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 /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 /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)) diff --git a/test_resources/diff-run/all-killed.golden b/test_resources/diff-run/all-killed.golden new file mode 100644 --- /dev/null +++ b/test_resources/diff-run/all-killed.golden @@ -0,0 +1,5 @@ + +PASS: All 3 mutation(s) accounted for. + +Full report: /run/report.txt +Machine-readable report: /run/report.json diff --git a/test_resources/diff-run/empty-selection.golden b/test_resources/diff-run/empty-selection.golden new file mode 100644 --- /dev/null +++ b/test_resources/diff-run/empty-selection.golden @@ -0,0 +1,5 @@ + +PASS: nothing to mutation-test in this diff. + +Full report: /run/report.txt +Machine-readable report: /run/report.json diff --git a/test_resources/diff-run/one-survivor-fail.golden b/test_resources/diff-run/one-survivor-fail.golden new file mode 100644 --- /dev/null +++ b/test_resources/diff-run/one-survivor-fail.golden @@ -0,0 +1,12 @@ + +FAIL: 1 surviving, 0 uncovered out of 3 mutation(s). + +Surviving mutations: + +BoolLit at Example/Lib.hs:12:8-12 + - True + + False + disable: add BoolLit to disabled-mutations in the plugin config + +Full report: /run/report.txt +Machine-readable report: /run/report.json diff --git a/test_resources/diff-run/one-uncovered-fail.golden b/test_resources/diff-run/one-uncovered-fail.golden new file mode 100644 --- /dev/null +++ b/test_resources/diff-run/one-uncovered-fail.golden @@ -0,0 +1,5 @@ + +FAIL: 0 surviving, 1 uncovered out of 3 mutation(s). + +Full report: /run/report.txt +Machine-readable report: /run/report.json