inspection-testing 0.4.5.0 → 0.4.6.0
raw patch · 4 files changed
+37/−14 lines, 4 filesdep ~basedep ~ghcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, ghc
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- inspection-testing.cabal +4/−4
- src/Test/Inspection/Core.hs +25/−10
- src/Test/Inspection/Plugin.hs +4/−0
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for inspection-testing +## 0.4.6.0 -- 2020-08-23++* Support GHC 9.2 (thanks @Bodigrim)+ ## 0.4.5.0 -- 2020-04-28 * Export some internals from `Test.Inspection.Plugin`, to make integration into
inspection-testing.cabal view
@@ -1,5 +1,5 @@ name: inspection-testing-version: 0.4.5.0+version: 0.4.6.0 synopsis: GHC plugin to do inspection testing description: Some carefully crafted libraries make promises to their users beyond functionality and performance.@@ -34,7 +34,7 @@ build-type: Simple extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10-Tested-With: GHC == 8.0.2, GHC == 8.2.*, GHC == 8.4.*, GHC ==8.6.*, GHC ==8.8.*, GHC ==8.10.*, GHC ==9.0.*+Tested-With: GHC == 8.0.2, GHC == 8.2.*, GHC == 8.4.*, GHC ==8.6.*, GHC ==8.8.*, GHC ==8.10.*, GHC ==9.0.*, GHC ==9.2.* source-repository head type: git@@ -45,8 +45,8 @@ Test.Inspection.Plugin Test.Inspection.Core hs-source-dirs: src- build-depends: base >=4.9 && <4.16- build-depends: ghc >= 8.0.2 && <9.1+ build-depends: base >=4.9 && <4.17+ build-depends: ghc >= 8.0.2 && <9.3 build-depends: template-haskell build-depends: containers build-depends: transformers
src/Test/Inspection/Core.hs view
@@ -1,6 +1,6 @@ -- | This module implements some analyses of Core expressions necessary for -- "Test.Inspection". Normally, users of this package can ignore this module.-{-# LANGUAGE CPP, FlexibleContexts #-}+{-# LANGUAGE CPP, FlexibleContexts, PatternSynonyms #-} module Test.Inspection.Core ( slice , pprSlice@@ -44,12 +44,22 @@ import TyCon (TyCon, isClassTyCon) #endif +#if MIN_VERSION_ghc(9,2,0)+import GHC.Types.Tickish+#endif+ import qualified Data.Set as S import Control.Monad.State.Strict import Control.Monad.Trans.Maybe import Data.List (nub) import Data.Maybe +#if !MIN_VERSION_ghc(9,2,0)+pattern Alt :: a -> b -> c -> (a, b, c)+pattern Alt a b c = (a, b, c)+{-# COMPLETE Alt #-}+#endif+ type Slice = [(Var, CoreExpr)] -- | Selects those bindings that define the given variable (with this variable first)@@ -67,7 +77,7 @@ seen <- gets (v `S.member`) unless seen $ do modify (S.insert v)- let Just e = lookup v binds+ let e = fromJust $ lookup v binds go e | otherwise = return () @@ -83,7 +93,7 @@ go (Type _) = pure () go (Coercion _) = pure () - goA (_, _, e) = go e+ goA (Alt _ _ e) = go e -- | Pretty-print a slice pprSlice :: Slice -> SDoc@@ -156,7 +166,7 @@ essentiallyVar (Lam v e) | it, isTyCoVar v = essentiallyVar e essentiallyVar (Cast e _) | it = essentiallyVar e #if MIN_VERSION_ghc(9,0,0)- essentiallyVar (Case s _ _ [(_, _, e)]) | it, isUnsafeEqualityProof s = essentiallyVar e+ essentiallyVar (Case s _ _ [Alt _ _ e]) | it, isUnsafeEqualityProof s = essentiallyVar e #endif essentiallyVar (Var v) = Just v essentiallyVar (Tick HpcTick{} e) | it = essentiallyVar e@@ -172,8 +182,8 @@ go env (Cast e1 _) e2 | it = go env e1 e2 go env e1 (Cast e2 _) | it = go env e1 e2 #if MIN_VERSION_ghc(9,0,0)- go env (Case s _ _ [(_, _, e1)]) e2 | it, isUnsafeEqualityProof s = go env e1 e2- go env e1 (Case s _ _ [(_, _, e2)]) | it, isUnsafeEqualityProof s = go env e1 e2+ go env (Case s _ _ [Alt _ _ e1]) e2 | it, isUnsafeEqualityProof s = go env e1 e2+ go env e1 (Case s _ _ [Alt _ _ e2]) | it, isUnsafeEqualityProof s = go env e1 e2 #endif go env (Cast e1 co1) (Cast e2 co2) = do guard (eqCoercionX env co1 co2) go env e1 e2@@ -218,11 +228,16 @@ go _ _ _ = guard False ------------ go_alt env (c1, bs1, e1) (c2, bs2, e2)+ go_alt env (Alt c1 bs1 e1) (Alt c2 bs2 e2) = guard (c1 == c2) >> go (rnBndrs2 env bs1 bs2) e1 e2 +#if MIN_VERSION_ghc(9,2,0)+ go_tick :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool+ go_tick env (Breakpoint _ lid lids) (Breakpoint _ rid rids)+#else go_tick :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool go_tick env (Breakpoint lid lids) (Breakpoint rid rids)+#endif = lid == rid && map (rnOccL env) lids == map (rnOccR env) rids go_tick _ l r = l == r @@ -257,7 +272,7 @@ goB (b, e) = goV b ++ go e - goA (_,pats, e) = concatMap goV pats ++ go e+ goA (Alt _ pats e) = concatMap goV pats ++ go e goT (TyVarTy _) = [] goT (AppTy t1 t2) = goT t1 ++ goT t2@@ -303,7 +318,7 @@ goB (_, e) = go e - goA (ac, _, e) = goAltCon ac && go e+ goA (Alt ac _ e) = goAltCon ac && go e goAltCon (DataAlt dc) | isNeedle (dataConName dc) = False goAltCon _ = True@@ -350,7 +365,7 @@ -- A let binding allocates if any variable is not a join point and not -- unlifted - goA a (_,_, e) = go a e+ goA a (Alt _ _ e) = go a e doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr, [TyCon]) doesNotContainTypeClasses slice tcNs
src/Test/Inspection/Plugin.hs view
@@ -29,6 +29,10 @@ import Outputable #endif +#if MIN_VERSION_ghc(9,2,0)+import GHC.Types.TyThing+#endif+ import Test.Inspection (Obligation(..), Property(..), Result(..)) import Test.Inspection.Core