base16

commit d3495b1030169800ba8d3b310696ffdd45ce6168
parent fd8077105c2393c499b22daa6eccb4b560811d69
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 17 Jan 2025 17:52:39 +0400

test: property tests

Diffstat:
M
ppad-base16.cabal
 | 
1
-
M
test/Main.hs
 | 
57
++++++++++++++++++++++++++++++++++++++++++++++++++-------

2 files changed, 50 insertions(+), 8 deletions(-)
diff --git a/ppad-base16.cabal b/ppad-base16.cabal
@@ -43,7 +43,6 @@ test-suite base16-tests
     , bytestring
     , ppad-base16
     , tasty
-    , tasty-hunit
     , tasty-quickcheck
 
 benchmark base16-bench
diff --git a/test/Main.hs b/test/Main.hs
@@ -4,17 +4,60 @@
 
 module Main where
 
+import qualified Data.ByteString as BS
 import qualified "ppad-base16" Data.ByteString.Base16 as B16
+import qualified "base16-bytestring" Data.ByteString.Base16 as R0
 import Test.Tasty
-import Test.Tasty.HUnit
+import qualified Test.Tasty.QuickCheck as Q
 
-main :: IO ()
-main = defaultMain $ testGroup "base16" [ tests ]
+newtype BS = BS BS.ByteString
+  deriving (Eq, Show)
+
+bytes :: Int -> Q.Gen BS.ByteString
+bytes k = do
+  l <- Q.chooseInt (0, k)
+  v <- Q.vectorOf l Q.arbitrary
+  pure (BS.pack v)
+
+instance Q.Arbitrary BS where
+  arbitrary = do
+    b <- bytes 1024
+    pure (BS b)
 
-pec = "6a746f62696e2077617320686572652062656e6368696e67207374756666"
-inp = "jtobin was here benching stuff"
+decode_inverts_encode :: BS -> Bool
+decode_inverts_encode (BS bs) = case B16.decode (B16.encode bs) of
+  Nothing -> False
+  Just b  -> b == bs
 
-tests = testGroup "base16" [
-    testCase "encode"  $ assertEqual mempty pec (B16.encode  inp)
+encode_matches_reference :: BS -> Bool
+encode_matches_reference (BS bs) =
+  let us = B16.encode bs
+      r0 = R0.encode bs
+  in  us == r0
+
+decode_matches_reference :: BS -> Bool
+decode_matches_reference (BS bs) =
+  let enc = R0.encode bs
+      us  = B16.decode enc
+      r0  = R0.decode enc
+  in  case us of
+        Nothing -> case r0 of
+          Left _ -> True
+          _ -> False
+        Just du -> case r0 of
+          Left _ -> False
+          Right d0 -> du == d0
+
+main :: IO ()
+main = defaultMain $
+  testGroup "ppad-base16" [
+    testGroup "property tests" [
+      Q.testProperty "decode . encode ~ id" $
+        Q.withMaxSuccess 5000 decode_inverts_encode
+    , Q.testProperty "encode matches reference" $
+        Q.withMaxSuccess 5000 encode_matches_reference
+    , Q.testProperty "decode matches reference" $
+        Q.withMaxSuccess 5000 decode_matches_reference
+    ]
   ]