diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for inspection-testing +## 0.4.5.0 -- 2020-04-28 + +* Export some internals from `Test.Inspection.Plugin`, to make integration into + testing frameworks easier (thanks @Bodigrim) + ## 0.4.4.0 -- 2020-04-21 * More GHC-9.0 compatibility (thanks @aadaa-fgtaa) diff --git a/inspection-testing.cabal b/inspection-testing.cabal --- a/inspection-testing.cabal +++ b/inspection-testing.cabal @@ -1,5 +1,5 @@ name: inspection-testing -version: 0.4.4.0 +version: 0.4.5.0 synopsis: GHC plugin to do inspection testing description: Some carefully crafted libraries make promises to their users beyond functionality and performance. diff --git a/src/Test/Inspection.hs b/src/Test/Inspection.hs --- a/src/Test/Inspection.hs +++ b/src/Test/Inspection.hs @@ -16,7 +16,7 @@ {-# LANGUAGE CPP #-} module Test.Inspection ( -- * Synopsis - -- $synposis + -- $synopsis -- * Registering obligations inspect, @@ -41,7 +41,7 @@ import GHC.Exts (lazy) import GHC.Generics (V1(), U1(), M1(), K1(), (:+:), (:*:), (:.:), Rec1, Par1) -{- $synposis +{- $synopsis To use inspection testing, you need to @@ -67,7 +67,7 @@ On GHC < 8.4, you have to explicitly load the plugin: @ -{-\# LANGUAGE TemplateHaskell \#-} +{-\# OPTIONS_GHC -fplugin=Test.Inspection.Plugin \#-} @ -} @@ -79,7 +79,7 @@ -- compatibility when new fields are added. You can also use the more -- mnemonic convenience functions like '(===)' or 'hasNoType'. -- --- The obligation needs to be passed to 'inspect'. +-- The obligation needs to be passed to 'inspect' or 'inspectTest'. data Obligation = Obligation { target :: Name -- ^ The target of a test obligation; invariably the name of a local @@ -157,7 +157,7 @@ -- | Declare two functions to be equal, but ignoring -- type lambdas, type arguments, type casts and hpc ticks (see 'EqualTo'). --- Note that `-fhpc` can prevent some optimizations; build without for more reliable analysis. +-- Note that @-fhpc@ can prevent some optimizations; build without for more reliable analysis. (==-) :: Name -> Name -> Obligation (==-) = mkEquality False True infix 9 ==- @@ -189,7 +189,7 @@ hasNoType n tn = mkObligation n (NoTypes [tn]) -- | Declare that a function’s implementation does not contain any generic types. --- This is just 'asNoType' applied to the usual type constructors used in +-- This is just 'hasNoType' applied to the usual type constructors used in -- "GHC.Generics". -- -- @inspect $ hasNoGenerics genericFunction@ @@ -256,13 +256,13 @@ didNotRunPluginError = lazy (error "Test.Inspection.Plugin did not run") {-# NOINLINE didNotRunPluginError #-} --- | This is a variant that allows compilation to succeed in any case, +-- | This is a variant of 'inspect' that allows compilation to succeed in any case, -- and instead indicates the result as a value of type 'Result', -- which allows seamless integration into test frameworks. -- -- This variant ignores the 'expectFail' field of the obligation. Instead, -- it is expected that you use the corresponding functionality in your test --- framework (e.g. tasty-expected-failure) +-- framework (e.g. [@tasty-expected-failure@](https://hackage.haskell.org/package/tasty-expected-failure)) inspectTest :: Obligation -> Q Exp inspectTest obl = do nameS <- genName diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs --- a/src/Test/Inspection/Core.hs +++ b/src/Test/Inspection/Core.hs @@ -93,8 +93,8 @@ -- | Pretty-print two slices, after removing variables occurring in both pprSliceDifference :: Slice -> Slice -> SDoc pprSliceDifference slice1 slice2 = - nest 4 (hang (text "LHS" Outputable.<> colon) 4 (pprSlice slice1')) $$ - nest 4 (hang (text "RHS" Outputable.<> colon) 4 (pprSlice slice2')) + hang (text "LHS" Outputable.<> colon) 4 (pprSlice slice1') $$ + hang (text "RHS" Outputable.<> colon) 4 (pprSlice slice2') where both = S.intersection (S.fromList (map fst slice1)) (S.fromList (map fst slice2)) slice1' = filter (\(v,_) -> v `S.notMember` both) slice1 diff --git a/src/Test/Inspection/Plugin.hs b/src/Test/Inspection/Plugin.hs --- a/src/Test/Inspection/Plugin.hs +++ b/src/Test/Inspection/Plugin.hs @@ -5,7 +5,12 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE LambdaCase #-} -module Test.Inspection.Plugin (plugin) where +module Test.Inspection.Plugin + ( plugin + , checkProperty + , CheckResult(..) + , prettyProperty + ) where import Control.Monad import System.Exit @@ -87,18 +92,19 @@ where name = case testName of Just n -> n - Nothing -> prettyProperty mod target property + Nothing -> prettyProperty (showTHName mod) target property -prettyProperty :: Module -> TH.Name -> Property -> String -prettyProperty mod target (EqualTo n2 False) = showTHName mod target ++ " === " ++ showTHName mod n2 -prettyProperty mod target (EqualTo n2 True) = showTHName mod target ++ " ==- " ++ showTHName mod n2 -prettyProperty mod target (NoTypes [t]) = showTHName mod target ++ " `hasNoType` " ++ showTHName mod t -prettyProperty mod target (NoTypes ts) = showTHName mod target ++ " mentions none of " ++ intercalate ", " (map (showTHName mod) ts) -prettyProperty mod target NoAllocation = showTHName mod target ++ " does not allocate" -prettyProperty mod target (NoTypeClasses []) = showTHName mod target ++ " does not contain dictionary values" -prettyProperty mod target (NoTypeClasses ts) = showTHName mod target ++ " does not contain dictionary values except of " ++ intercalate ", " (map (showTHName mod) ts) -prettyProperty mod target (NoUseOf ns) = showTHName mod target ++ " uses none of " ++ intercalate ", " (map (showTHName mod) ns) -prettyProperty mod target CoreOf = showTHName mod target ++ " core dump" -- :) +prettyProperty :: (TH.Name -> String) -> TH.Name -> Property -> String +prettyProperty showName target = \case + EqualTo n2 False -> showName target ++ " === " ++ showName n2 + EqualTo n2 True -> showName target ++ " ==- " ++ showName n2 + NoTypes [t] -> showName target ++ " `hasNoType` " ++ showName t + NoTypes ts -> showName target ++ " mentions none of " ++ intercalate ", " (map showName ts) + NoAllocation -> showName target ++ " does not allocate" + NoTypeClasses [] -> showName target ++ " does not contain dictionary values" + NoTypeClasses ts -> showName target ++ " does not contain dictionary values except of " ++ intercalate ", " (map showName ts) + NoUseOf ns -> showName target ++ " uses none of " ++ intercalate ", " (map showName ns) + CoreOf -> showName target ++ " core dump" -- :) -- | Like show, but omit the module name if it is he current module showTHName :: Module -> TH.Name -> String