commit b8ce66e205120a75884c8649b924ecc2df05d8b7
parent 5e927388a31a1ee047259c12fc5ce4984ecf83cc
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 20 Apr 2026 15:57:10 +0800
test: add property tests
Add 4 property tests:
- setFeature then hasFeature roundtrip
- setFeatureWithDeps always passes validateLocal
- parse . render is identity
- setFeature never sets both bits of a pair
Diffstat:
| M | test/Main.hs | | | 43 | +++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 43 insertions(+), 0 deletions(-)
diff --git a/test/Main.hs b/test/Main.hs
@@ -468,8 +468,51 @@ propertyTests = testGroup "Properties" [
, testProperty "optionalBit only succeeds for odd" $
\(n :: Word16) -> isJust (optionalBit n) === (n `mod` 2 == 1)
+
+ , testProperty "setFeature then hasFeature" $
+ forAll genFeatureAndLevel $ \(f, lvl) ->
+ let fv = setFeature f lvl empty
+ in hasFeature f fv == Just lvl
+
+ , testProperty
+ "setFeatureWithDeps passes validateLocal" $
+ forAll genInitFeatureAndLevel $ \(f, lvl) ->
+ let fv = setFeatureWithDeps f lvl empty
+ in isRight (validateLocal Init fv)
+
+ , testProperty "parse . render is identity" $
+ \bs ->
+ let stripped = BS.dropWhile (== 0) (BS.pack bs)
+ fv = parse stripped
+ in parse (render fv) == fv
+
+ , testProperty
+ "setFeature never sets both bits" $
+ forAll genFeatureAndLevel $ \(f, lvl) ->
+ let fv = setFeature f lvl empty
+ in isRight (validateNoBothBits fv)
]
+-- | Generate a random known feature and level.
+genFeatureAndLevel :: Gen (Feature, FeatureLevel)
+genFeatureAndLevel = do
+ f <- elements knownFeatures
+ lvl <- elements [Required, Optional]
+ pure (f, lvl)
+
+-- | Generate a feature valid in Init context with a level.
+genInitFeatureAndLevel :: Gen (Feature, FeatureLevel)
+genInitFeatureAndLevel = do
+ f <- elements initFeatures
+ lvl <- elements [Required, Optional]
+ pure (f, lvl)
+ where
+ initFeatures =
+ filter validForInit knownFeatures
+ validForInit f =
+ null (featureContexts f)
+ || Init `elem` featureContexts f
+
-- | Remove duplicates from a list.
removeDups :: Eq a => [a] -> [a]
removeDups [] = []
