inspection-testing 0.5.0.2 → 0.5.0.3
raw patch · 4 files changed
+29/−13 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
- examples/NS_NP.hs +3/−2
- inspection-testing.cabal +4/−4
- src/Test/Inspection/Core.hs +18/−7
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for inspection-testing +## 0.5.0.3 -- 2023-12-29++* Support GHC 9.10 (thanks Bodigrim)+ ## 0.5.0.2 -- 2023-07-10 * Support GHC 9.8 (thanks Bodigrim)
examples/NS_NP.hs view
@@ -3,13 +3,14 @@ {-# OPTIONS_GHC -O -fplugin-opt=Test.Inspection.Plugin:quiet -Wno-overlapping-patterns #-} module NS_NP (main) where +import Data.Kind import Test.Inspection -data NS (f :: k -> *) (xs :: [k]) where+data NS (f :: k -> Type) (xs :: [k]) where Z :: f x -> NS f (x : xs) S :: !(NS f xs) -> NS f (x : xs) -data NP (f :: k -> *) (xs :: [k]) where+data NP (f :: k -> Type) (xs :: [k]) where Nil :: NP f '[] (:*) :: f x -> !(NP f xs) -> NP f (x : xs)
inspection-testing.cabal view
@@ -1,5 +1,5 @@ name: inspection-testing-version: 0.5.0.2+version: 0.5.0.3 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.*, GHC ==9.2.*, GHC ==9.4.*, GHC ==9.6.*+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.*, GHC ==9.4.*, GHC ==9.6.*, GHC ==9.8.* 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.20- build-depends: ghc >= 8.0.2 && <9.9+ build-depends: base >=4.9 && <4.21+ build-depends: ghc >= 8.0.2 && <9.11 build-depends: template-haskell build-depends: containers build-depends: transformers
src/Test/Inspection/Core.hs view
@@ -13,6 +13,7 @@ ) where #if MIN_VERSION_ghc(9,0,0)+import GHC.Builtin.Types (isCTupleTyConName) import GHC.Core import GHC.Core.Utils import GHC.Core.TyCo.Rep@@ -31,6 +32,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon (TyCon, isClassTyCon) #else+import TysWiredIn (isCTupleTyConName) import CoreSyn import CoreUtils import CoreSubst@@ -186,9 +188,11 @@ -- (This is mostly to work-around the buggy CSE in GHC-8.0) -- It also breaks if there is shadowing. eqSlice :: Equivalence -> Slice -> Slice -> Bool-eqSlice _ slice1 slice2 | null slice1 || null slice2 = null slice1 == null slice2+eqSlice _ [] [] = True+eqSlice _ _ [] = False+eqSlice _ [] _ = False -- Mostly defensive programming (slices should not be empty)-eqSlice eqv slice1 slice2+eqSlice eqv slice1@((head1, _) : _) slice2@((head2, _) : _) -- slices are equal if there exist any result with no "unification" obligations left. = any (S.null . snd) results where@@ -208,7 +212,7 @@ -- results. If there are no pairs to be equated, all is fine. results :: [((), VarPairSet)]- results = runStateT (loop' (mkRnEnv2 emptyInScopeSet) S.empty (fst (head slice1)) (fst (head slice2))) S.empty+ results = runStateT (loop' (mkRnEnv2 emptyInScopeSet) S.empty head1 head2) S.empty -- while there are obligations left, try to equate them. loop :: RnEnv2 -> VarPairSet -> StateT VarPairSet [] ()@@ -264,7 +268,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 _ _ [Alt _ _ e]) | it, isUnsafeEqualityProof s = essentiallyVar e+ essentiallyVar (Case s b _ alts) | it, Just e <- isUnsafeEqualityCase s b alts = essentiallyVar e #endif essentiallyVar (Var v) = Just v essentiallyVar (Tick HpcTick{} e) | it = essentiallyVar e@@ -292,8 +296,8 @@ go lv env (Cast e1 _) e2 | it = go lv env e1 e2 go lv env e1 (Cast e2 _) | it = go lv env e1 e2 #if MIN_VERSION_ghc(9,0,0)- go lv env (Case s _ _ [Alt _ _ e1]) e2 | it, isUnsafeEqualityProof s = go lv env e1 e2- go lv env e1 (Case s _ _ [Alt _ _ e2]) | it, isUnsafeEqualityProof s = go lv env e1 e2+ go lv env (Case s b _ alts) e2 | it, Just e1 <- isUnsafeEqualityCase s b alts = go lv env e1 e2+ go lv env e1 (Case s b _ alts) | it, Just e2 <- isUnsafeEqualityCase s b alts = go lv env e1 e2 #endif go lv env (Cast e1 co1) (Cast e2 co2) = traceBlock lv "CAST" "" $ \lv -> do guard (eqCoercionX env co1 co2)@@ -380,6 +384,13 @@ -- continue with the rest of bindings, adding a pair as matching one. goBinds lv (rnBndr2 env v1 v2) xs ys +#if !MIN_VERSION_ghc(9,9,0) && MIN_VERSION_ghc(9,0,0)+isUnsafeEqualityCase :: CoreExpr -> Id -> [CoreAlt] -> Maybe CoreExpr+isUnsafeEqualityCase scrut _bndr [Alt _ _ rhs]+ | isUnsafeEqualityProof scrut = Just rhs+isUnsafeEqualityCase _ _ _ = Nothing+#endif+ #if !MIN_VERSION_ghc(9,2,0) type CoreTickish = Tickish Id #endif@@ -552,7 +563,7 @@ doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr, [TyCon]) doesNotContainTypeClasses slice tcNs- = allTyCons (\tc -> not (isClassTyCon tc) || any (getName tc ==) tcNs) slice+ = allTyCons (\tc -> not (isClassTyCon tc) || isCTupleTyConName (getName tc) || any (getName tc ==) tcNs) slice rename :: [(Var, Var)] -> CoreExpr -> CoreExpr rename rn = substExpr' sub where