commit 2b9113ae71752c0ba41c1cf30a694d3d36561e72
parent 446a315f0a3ee0cd871773b03762ef63d9a782a3
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 15:22:46 +0400
test: exercise both codec paths and invalid inputs
Every property and unit test now runs against both the public
(dispatching) codec and the pure Haskell one, so the scalar path is
covered on aarch64 hosts too. Generated inputs are slices at non-zero
offsets.
Adds a differential decode test against base16-bytestring on mostly-hex
strings with occasional junk bytes and odd lengths, a check of every
byte value at every position of a string spanning a full NEON block
plus a scalar tail, single-byte corruption at every position for
lengths spanning several NEON blocks and all tail lengths, and
odd-length rejection.
Diffstat:
| M | test/Main.hs | | | 150 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------ |
1 file changed, 116 insertions(+), 34 deletions(-)
diff --git a/test/Main.hs b/test/Main.hs
@@ -4,72 +4,154 @@
module Main where
+import Control.Monad (forM_)
import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
import qualified "ppad-base16" Data.ByteString.Base16 as B16
+import qualified "ppad-base16" Data.ByteString.Base16.Pure as Pure
import qualified "base16-bytestring" Data.ByteString.Base16 as R0
+import Data.Word (Word8)
import Test.Tasty
import qualified Test.Tasty.QuickCheck as Q
import qualified Test.Tasty.HUnit as H
-newtype BS = BS BS.ByteString
- deriving (Eq, Show)
+-- generators -----------------------------------------------------------------
+-- random bytes, as a slice at a random offset into a larger buffer, so
+-- that inputs with a non-zero 'ByteString' offset are exercised
bytes :: Int -> Q.Gen BS.ByteString
bytes k = do
l <- Q.chooseInt (0, k)
- v <- Q.vectorOf l Q.arbitrary
- pure (BS.pack v)
+ o <- Q.chooseInt (0, 32)
+ v <- Q.vectorOf (o + l) Q.arbitrary
+ pure (BS.drop o (BS.pack v))
+
+newtype BS = BS BS.ByteString
+ deriving (Eq, Show)
instance Q.Arbitrary BS where
arbitrary = do
b <- bytes 1024
pure (BS b)
-decode_inverts_encode :: BS -> Bool
-decode_inverts_encode (BS bs) = case B16.decode (B16.encode bs) of
- Nothing -> False
- Just b -> b == bs
+hex_chars :: BS.ByteString
+hex_chars = "0123456789abcdefABCDEF"
+
+-- mostly-hex strings of arbitrary (including odd) length: each byte is
+-- a hex char with high probability, otherwise an arbitrary byte
+newtype Hexish = Hexish BS.ByteString
+ deriving (Eq, Show)
+
+instance Q.Arbitrary Hexish where
+ arbitrary = do
+ l <- Q.chooseInt (0, 256)
+ o <- Q.chooseInt (0, 32)
+ junk <- Q.elements [0, 1, 50 :: Int]
+ v <- Q.vectorOf (o + l) $ do
+ p <- Q.chooseInt (1, 100)
+ if p <= junk
+ then Q.arbitrary
+ else Q.elements (BS.unpack hex_chars)
+ pure (Hexish (BS.drop o (BS.pack v)))
+
+-- decoders under test --------------------------------------------------------
+
+decoders :: [(String, BS.ByteString -> Maybe BS.ByteString)]
+decoders = [("public", B16.decode), ("pure", Pure.decode)]
+
+ref_decode :: BS.ByteString -> Maybe BS.ByteString
+ref_decode bs = case R0.decode bs of
+ Left _ -> Nothing
+ Right d -> Just d
+
+is_hex :: Word8 -> Bool
+is_hex c = BS.elem c hex_chars
+
+-- properties -----------------------------------------------------------------
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
+ let r0 = R0.encode bs
+ in B16.encode bs == r0 && Pure.encode bs == r0
+
+decode_inverts_encode :: BS -> Bool
+decode_inverts_encode (BS bs) =
+ let enc = B16.encode bs
+ in all (\(_, dec) -> dec enc == Just bs) decoders
+
+decode_matches_reference :: Hexish -> Bool
+decode_matches_reference (Hexish bs) =
+ let r0 = ref_decode bs
+ in B16.decode bs == r0 && Pure.decode bs == r0
+
+-- unit tests -----------------------------------------------------------------
case_handled :: TestTree
-case_handled = H.testCase "decodes uppercase hex" $ do
- let lhex = "deadbeef"
- uhex = "DEADBEEF"
- case liftA2 (,) (B16.decode lhex) (B16.decode uhex) of
- Nothing -> H.assertBool mempty False
- Just (a, b) -> H.assertEqual mempty a b
+case_handled = H.testCase "decodes uppercase and mixed-case hex" $
+ forM_ decoders $ \(nam, dec) -> do
+ let l = dec "deadbeef"
+ H.assertEqual nam (Just "\xde\xad\xbe\xef") l
+ H.assertEqual nam l (dec "DEADBEEF")
+ H.assertEqual nam l (dec "DeAdBeEf")
+
+-- every byte value, at every position of a string spanning one full NEON
+-- block plus a scalar tail, is accepted iff it is a hex char
+every_byte_every_position :: TestTree
+every_byte_every_position =
+ H.testCase "every byte at every position" $ do
+ let base = B8.replicate 34 '0'
+ forM_ [0 .. 255 :: Int] $ \c ->
+ forM_ [0 .. BS.length base - 1] $ \i -> do
+ let w = fromIntegral c :: Word8
+ inp = BS.take i base <> BS.singleton w <> BS.drop (i + 1) base
+ pec = if is_hex w then ref_decode inp else Nothing
+ msg = "byte " <> show c <> ", position " <> show i
+ forM_ decoders $ \(nam, dec) ->
+ H.assertEqual (nam <> ", " <> msg) pec (dec inp)
+
+-- for every length spanning several NEON blocks and every tail length,
+-- a single invalid byte at any position causes decoding to fail
+single_corruption :: TestTree
+single_corruption = H.testCase "single invalid byte anywhere" $ do
+ let bad = BS.pack [0x00, 0x20, 0x7f, 0x80, 0xff] <> "/:@G`g"
+ forM_ [1 .. 80 :: Int] $ \n -> do
+ let raw = BS.pack (fmap fromIntegral [7 * j + 3 | j <- [1 .. n]])
+ enc = upper_odd (B16.encode raw)
+ upper_odd = BS.pack . zipWith up [0 :: Int ..] . BS.unpack
+ up j c | odd j && c >= 0x61 = c - 0x20
+ | otherwise = c
+ forM_ decoders $ \(nam, dec) ->
+ H.assertEqual (nam <> ", intact, n = " <> show n) (Just raw) (dec enc)
+ forM_ [0 .. BS.length enc - 1] $ \i ->
+ forM_ (BS.unpack bad) $ \w -> do
+ let inp = BS.take i enc <> BS.singleton w <> BS.drop (i + 1) enc
+ msg = "n = " <> show n <> ", position " <> show i
+ <> ", byte " <> show w
+ forM_ decoders $ \(nam, dec) ->
+ H.assertEqual (nam <> ", " <> msg) Nothing (dec inp)
+
+odd_lengths :: TestTree
+odd_lengths = H.testCase "odd-length inputs" $
+ forM_ [1, 3 .. 99 :: Int] $ \l ->
+ forM_ decoders $ \(nam, dec) ->
+ H.assertEqual (nam <> ", length " <> show l) Nothing
+ (dec (B8.replicate l 'a'))
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.testProperty "encode matches reference" $
Q.withMaxSuccess 5000 encode_matches_reference
+ , Q.testProperty "decode . encode ~ id" $
+ Q.withMaxSuccess 5000 decode_inverts_encode
, Q.testProperty "decode matches reference" $
Q.withMaxSuccess 5000 decode_matches_reference
]
, testGroup "unit tests" [
case_handled
+ , every_byte_every_position
+ , single_corruption
+ , odd_lengths
]
]
-
