inspection-testing 0.4.1.1 → 0.4.1.2

raw patch · 4 files changed

+34/−15 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• examples/NS_NP.hs +1/−1
• inspection-testing.cabal +1/−1
• src/Test/Inspection/Plugin.hs +27/−13

@@ -1,5 +1,10 @@ # Revision history for inspection-testing +## 0.4.1.2 -- 2019-02-23++* Do not force recompilation with GHC >= 8.6+* Support `-fplugin-opt=Test.Inspection.Plugin:quiet`+ ## 0.4.1.1 -- 2018-11-17  * Fix a bug with `doesNotUse` and data constructors

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, TypeFamilies, DataKinds, PolyKinds, TypeOperators #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -O #-}+{-# OPTIONS_GHC -O -fplugin-opt=Test.Inspection.Plugin:quiet #-} module NS_NP (main) where  import Test.Inspection

@@ -1,5 +1,5 @@ name:                inspection-testing-version:             0.4.1.1+version:             0.4.1.2 synopsis:            GHC plugin to do inspection testing description:         Some carefully crafted libraries make promises to their                      users beyond functionality and performance.

@@ -22,21 +22,32 @@ import Test.Inspection (Obligation(..), Property(..), Result(..)) import Test.Inspection.Core --- | The plugin. It supports the option @-fplugin-opt=Test.Inspection.Plugin:keep-going@ to--- ignore a failing build.+-- | The plugin. It supports some options:+--+-- * @-fplugin-opt=Test.Inspection.Plugin:keep-going@ to ignore a failing build+-- * @-fplugin-opt=Test.Inspection.Plugin:quiet@ to be silent if all obligations are fulfilled plugin :: Plugin-plugin = defaultPlugin { installCoreToDos = install }+plugin = defaultPlugin+    { installCoreToDos = install+#if __GLASGOW_HASKELL__ >= 806+    , pluginRecompile = \_args -> pure NoForceRecompile+#endif+    }  data UponFailure = AbortCompilation | KeepGoing deriving Eq +data ReportingMode = Verbose | Quiet deriving Eq+ data ResultTarget = PrintAndAbort | StoreAt Name  install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install args passes = return $ passes ++ [pass]   where-    pass = CoreDoPluginPass "Test.Inspection.Plugin" (proofPass upon_failure)+    pass = CoreDoPluginPass "Test.Inspection.Plugin" (proofPass upon_failure report)     upon_failure | "keep-going" `elem` args = KeepGoing                  | otherwise                = AbortCompilation+    report | "quiet" `elem` args = Quiet+           | otherwise           = Verbose   extractObligations :: ModGuts -> (ModGuts, [(ResultTarget, Obligation)])@@ -90,8 +101,8 @@ tick :: Stat -> Stats tick s = M.singleton s 1 -checkObligation :: ModGuts -> (ResultTarget, Obligation) -> CoreM (Updates, Stats)-checkObligation guts (reportTarget, obl) = do+checkObligation :: ReportingMode -> ModGuts -> (ResultTarget, Obligation) -> CoreM (Updates, Stats)+checkObligation report guts (reportTarget, obl) = do      res <- checkProperty guts (target obl) (property obl)     case reportTarget of@@ -99,7 +110,8 @@             category <- case (res, expectFail obl) of                 -- Property holds                 (Nothing, False) -> do-                    putMsgS $ prettyObligation (mg_module guts) obl expSuccess+                    unless (report == Quiet) $+                        putMsgS $ prettyObligation (mg_module guts) obl expSuccess                     return ExpSuccess                 (Nothing, True) -> do                     putMsgS $ prettyObligation (mg_module guts) obl unexpSuccess@@ -110,7 +122,8 @@                     putMsg $ reportDoc                     return UnexpFailure                 (Just _, True) -> do-                    putMsgS $ prettyObligation (mg_module guts) obl expFailure+                    unless (report == Quiet) $+                        putMsgS $ prettyObligation (mg_module guts) obl expFailure                     return ExpFailure             return ([], tick category)         StoreAt name -> do@@ -221,8 +234,8 @@             Just (v',e') -> pure . Just $ nest 4 (ppr v' <+> text "=" <+> ppr e')             Nothing -> pure Nothing   where binds = flattenBinds (mg_binds guts)-     + fromTHName :: TH.Name -> CoreM Name fromTHName thn = thNameToGhcName thn >>= \case     Nothing -> do@@ -248,15 +261,15 @@ resultToExpr (Success s) = App <$> dcExpr 'Success <*> mkStringExpr s resultToExpr (Failure s) = App <$> dcExpr 'Failure <*> mkStringExpr s -proofPass :: UponFailure -> ModGuts -> CoreM ModGuts-proofPass upon_failure guts = do+proofPass :: UponFailure -> ReportingMode -> ModGuts -> CoreM ModGuts+proofPass upon_failure report guts = do     dflags <- getDynFlags     when (optLevel dflags < 1) $         warnMsg $ fsep $ map text $ words "Test.Inspection: Compilation without -O detected. Expect optimizations to fail."      let (guts', obligations) = extractObligations guts     (toStore, stats) <- (concat `bimap` M.unionsWith (+)) . unzip <$>-        mapM (checkObligation guts') obligations+        mapM (checkObligation report guts') obligations     let n = sum stats :: Int      guts'' <- storeResults toStore  guts'@@ -271,7 +284,8 @@     -- Only print a message if there are some compile-time results to report     unless (q StoredResult == n) $ do         if q ExpSuccess + q ExpFailure + q StoredResult == n-        then putMsg $ text "inspection testing successful" $$ summary_message+        then unless (report == Quiet) $+                putMsg $ text "inspection testing successful" $$ summary_message         else case upon_failure of             AbortCompilation -> do                 errorMsg $ text "inspection testing unsuccessful" $$ summary_message