sydtest-mutation-plugin 0.4.5.0 → 0.4.6.0

raw patch · 3 files changed

+125/−6 lines, 3 files

Files

• CHANGELOG.md +23/−0
• src/Test/Syd/Mutation/Plugin/Operator/ConstConstructor.hs +101/−5
• sydtest-mutation-plugin.cabal +1/−1

@@ -1,5 +1,28 @@ # Changelog +## [0.4.6.0] - 2026-07-29++### Added++* A `skip-calls-to` config key on `ConstConstructor`, the same key `ElideCall`+  and `SwitchFunctionArguments` already take.  A function whose result is+  always the same constructor -- a delegating `sqlType Proxy = sqlType (Proxy+  :: Proxy Text)`, say -- makes every call to it an equivalent, unkillable+  mutant.  Whether a function is like that is a semantic property the plugin+  cannot detect, so listing its name suppresses the operator at every call to+  it.  The definition itself is still mutated: the key skips calls.++### Fixed++* `ConstConstructor` no longer replaces a binding that is defined as a nullary+  constructor with that same constructor.  `Data.Map.empty` is `Tip`, so+  rewriting it to `Tip` produced an unkillable mutant at every use of it (and+  of `Set.empty`, `Seq.empty`, and any `emptyFoo = NoFoo` of your own).  The+  operator already declined this no-op where the constructor is written out;+  it now also recognises it through a name, by reading the unfolding GHC+  recorded for the binding.  A binding in the module being compiled has no+  unfolding yet, so an alias defined locally is still mutated to itself.+ ## [0.4.5.0] - 2026-07-29  ### Added

@@ -5,17 +5,23 @@ module Test.Syd.Mutation.Plugin.Operator.ConstConstructor (theOperator) where  import Control.Monad.Reader (asks)+import qualified Data.Map as Map+import Data.Text (Text) import qualified Data.Text as T import GHC import GHC.Builtin.Types (boolTyCon, listTyCon, maybeTyCon)+import GHC.Core (CoreExpr, Expr (..), isTyCoArg, maybeUnfoldingTemplate) import GHC.Core.ConLike (ConLike (RealDataCon)) import GHC.Core.DataCon (dataConFullSig, dataConWrapId) import GHC.Core.TyCon (tyConDataCons_maybe) import GHC.Core.Type (splitTyConApp_maybe)-import GHC.Types.Id (isDataConId_maybe)+import GHC.Types.Id (isDataConId_maybe, realIdUnfolding)+import GHC.Types.Name (getOccString) import GHC.Types.Name.Occurrence (isSymOcc, occNameString)+import GHC.Types.Var (isTyVar) import Test.Syd.Mutation.Plugin.Instrument (InstrM, InstrumentEnv (..), MutationAlt (..), MutationOperator (..), MutationOperatorKind (..), OpAppCtx (..), SrcSpanDelta (..))-import Test.Syd.Mutation.Plugin.Operator.Util (ConstFnMatch (..), ConstructorHeads (..), arrowTy, mkConstLambda, prefixFormPreview, viewConstFnResultBy)+import Test.Syd.Mutation.Plugin.Operator.Util (ConstFnMatch (..), ConstructorHeads (..), arrowTy, collectApp, headFunctionName, mkConstLambda, nameMatchCandidates, prefixFormPreview, viewConstFnResultBy)+import Test.Syd.Mutation.Plugin.OptParse (OperatorConfig (..), operatorExtraStrings)  -- | Replace an expression whose type is @arg1 -> ... -> argN -> T tys@ (with -- @N >= 0@) with a constant function returning a nullary constructor of @T@,@@ -55,6 +61,25 @@ -- An arity-\>=1 firing is suppressed when 'instrumentEnvAppDepth' >= arity; -- see 'ConstNothing' for that dominance rule. --+-- A function whose result is always the same constructor produces an+-- /equivalent/ mutant at every call to it: replacing the call with that+-- constructor cannot change anything, so no test can kill it.  A delegating+-- @sqlType Proxy = sqlType (Proxy :: Proxy Text)@ is the shape that keeps+-- coming up -- @sqlType@ answers with a constant of its type by definition.+-- Which functions those are is a semantic property the plugin cannot detect,+-- so calls to them are suppressed by listing the function's name under the+-- operator's @skip-calls-to@ config key:+--+-- > operators:+-- >   ConstConstructor:+-- >     skip-calls-to:+-- >       - sqlType+--+-- A name matches either bare (@sqlType@, matching any module) or fully+-- qualified (@Database.Persist.Sql.sqlType@), by the defining module or by a+-- module it is imported through.  This is the same matching the @ignore@ key+-- and the other operators' @skip-calls-to@ keys use.+-- -- The manifest preview names the constructor unqualified even when the -- mutated module does not have it in scope.  The mutant itself is built from -- the constructor's 'Id' and compiles regardless of scope, so this only@@ -78,9 +103,19 @@ action le ConstFnMatch {cfnArgTys, cfnResTy, cfnTyConArgs} cons = do   opAppCtx <- asks instrumentEnvOpAppCtx   appDepth <- asks instrumentEnvAppDepth+  -- Suppress calls to functions the user has marked constant-valued (this+  -- operator's mutants for them are equivalent and unkillable).  See this+  -- module's haddock.+  opsConfig <- asks instrumentEnvOperatorsConfig+  rdrEnv <- asks instrumentEnvRdrEnv+  let extra = maybe Map.empty operatorConfigExtra (Map.lookup "ConstConstructor" opsConfig)+  let skipCallsTo = operatorExtraStrings "skip-calls-to" extra+  let skipThisCall = case headFunctionName (fst (collectApp le)) of+        Just n -> any (`elem` skipCallsTo) (nameMatchCandidates rdrEnv n)+        Nothing -> False   let arity = length cfnArgTys   -- See 'ConstNothing' for the dominance rule.-  if arity >= 1 && appDepth >= arity+  if (arity >= 1 && appDepth >= arity) || skipThisCall     then pure []     else       let wholeTy = arrowTy cfnArgTys cfnResTy@@ -122,10 +157,31 @@                     mutAltOriginal = origLabel,                     mutAltReplacement = replLabel,                     mutAltDelta = delta,-                    mutAltMitigation = Nothing+                    mutAltMitigation = mitigationFor le headCon                   }        in pure [mkAlt dc | dc <- cons, Just dc /= headCon] +-- | Hint shown for a surviving mutation: if the called function always+-- answers with the same constructor the mutant is equivalent (unkillable),+-- and listing the function under @skip-calls-to@ suppresses it.  'Nothing'+-- when the expression is already a constructor, or its head is not a named+-- function, so there is nothing to suggest.+mitigationFor :: LHsExpr GhcTc -> Maybe DataCon -> Maybe Text+mitigationFor _ (Just _) = Nothing+mitigationFor le Nothing = do+  n <- headFunctionName (fst (collectApp le))+  let fn = getOccString n+  pure $+    T.pack $+      concat+        [ "If `",+          fn,+          "` always returns the same constructor this is an equivalent mutant ",+          "that no test can kill; add `",+          fn,+          "` to this operator's `skip-calls-to` config to suppress it."+        ]+ -- | How the constructor is written in an expression: a symbolic constructor -- like @(:<)@ needs its parentheses to be one. conSourceName :: DataCon -> String@@ -175,14 +231,54 @@ -- application.  Peels the wrappers the typechecker leaves around a -- constructor occurrence, mirroring -- 'Test.Syd.Mutation.Plugin.Operator.Util.nonConstructorHead'.+--+-- A variable counts when it is a constructor itself and also when it is a+-- binding defined as one; see 'aliasedConstructor'. constructorHead :: LHsExpr GhcTc -> Maybe DataCon constructorHead = \case   L _ (XExpr (ConLikeTc (RealDataCon dc) _ _)) -> Just dc-  L _ (HsVar _ (L _ v)) -> isDataConId_maybe v+  L _ (HsVar _ (L _ v)) -> case isDataConId_maybe v of+    Just dc -> Just dc+    Nothing -> aliasedConstructor v   L _ (HsApp _ f _) -> constructorHead f   L _ (HsAppType _ f _) -> constructorHead f   L _ (HsPar _ e) -> constructorHead e   L _ (ExprWithTySig _ e _) -> constructorHead e   L _ (XExpr (WrapExpr (HsWrap _ e))) -> constructorHead (noLocA e)   L _ (XExpr (ExpandedThingTc _ e)) -> constructorHead (noLocA e)+  _ -> Nothing++-- | The nullary constructor a binding is an alias for, read off the unfolding+-- GHC recorded for it.+--+-- @Data.Map.Strict.empty@ is @Tip@: an ordinary function whose entire+-- definition is a nullary constructor.  Replacing an occurrence of it with+-- that constructor is exactly the no-op this operator already declines to+-- offer when the constructor is written out, only reached through a name, so+-- it has to be recognised here or every @Map.empty@ in a codebase becomes an+-- unkillable mutant.  The same holds for @Set.empty@, @Seq.empty@, and any+-- @emptyFoo = NoFoo@ of the user's own.+--+-- Best-effort: only an imported binding has an unfolding at this stage, and+-- only when its defining module was compiled with enough optimisation to+-- record one.  A miss costs a no-op mutant, which is what would be produced+-- without this check at all.+aliasedConstructor :: Id -> Maybe DataCon+aliasedConstructor v = do+  template <- maybeUnfoldingTemplate (realIdUnfolding v)+  coreConstructorHead template++-- | The constructor a Core expression is a bare occurrence of.+--+-- Type abstractions and type applications are peeled because a constructor of+-- a parameterised type reaches its use site under them (@empty@ unfolds to+-- @\\\@k \\\@a -> Tip \@k \@a@).  A value argument is not peeled: it means the+-- constructor is applied to something and so is not a constant of its type.+coreConstructorHead :: CoreExpr -> Maybe DataCon+coreConstructorHead = \case+  Var i -> isDataConId_maybe i+  App f a | isTyCoArg a -> coreConstructorHead f+  Lam b e | isTyVar b -> coreConstructorHead e+  Cast e _ -> coreConstructorHead e+  Tick _ e -> coreConstructorHead e   _ -> Nothing

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sydtest-mutation-plugin-version:        0.4.5.0+version:        0.4.6.0 synopsis:       GHC plugin that instruments code for sydtest's mutation testing description:    A GHC source plugin that instruments code under test with the coverage and mutation hooks that sydtest's mutation testing infrastructure needs. See https://github.com/NorfairKing/sydtest#readme for more information. category:       Testing