-
Notifications
You must be signed in to change notification settings - Fork 157
Commit
- Loading branch information
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,47 @@ | ||
{-# LANGUAGE CPP #-} | ||
module Tests.Properties.Validate (testValidate) where | ||
|
||
import Data.Array.Byte (ByteArray) | ||
import Data.ByteString (ByteString) | ||
import qualified Data.ByteString as B | ||
import Data.ByteString.Short (toShort) | ||
import Data.Either (isRight) | ||
import Data.Text.Encoding (decodeUtf8', encodeUtf8) | ||
import Data.Text.Internal.Validate (isValidUtf8ByteString, isValidUtf8ByteArray) | ||
import Test.Tasty (TestTree, testGroup) | ||
import Test.Tasty.QuickCheck ((===), Gen, Property, | ||
testProperty, arbitrary, forAllShrinkShow, forAllShrink, oneof, shrink) | ||
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (ubuntu-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (ubuntu-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (windows-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (windows-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (windows-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (windows-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (ubuntu-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (windows-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (ubuntu-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (windows-latest, latest)
Check warning on line 13 in tests/Tests/Properties/Validate.hs GitHub Actions / build (macOS-latest, latest)
|
||
import Tests.QuickCheckUtils () | ||
#if MIN_VERSION_bytestring(0,12,0) | ||
import Data.ByteString.Short (unShortByteString) | ||
#else | ||
import Data.ByteString.Short (ShortByteString(SBS)) | ||
import Data.Array.Byte (ByteArray(ByteArray)) | ||
|
||
unShortByteString :: ShortByteString -> ByteArray | ||
unShortByteString (SBS ba) = ByteArray ba | ||
#endif | ||
|
||
testValidate :: TestTree | ||
testValidate = testGroup "validate" | ||
[ testProperty "bytestring" $ forAllShrink genByteString shrink $ \bs -> | ||
isValidUtf8ByteString bs === isRight (decodeUtf8' bs) | ||
-- We have all we need to shrink here but I'm too lazy to do that now. | ||
, testProperty "bytearray" $ forAllByteArray $ \ba off len bs -> | ||
isValidUtf8ByteArray ba off len === isRight (decodeUtf8' bs) | ||
] | ||
|
||
genByteString :: Gen ByteString | ||
genByteString = oneof | ||
[ arbitrary | ||
, encodeUtf8 <$> arbitrary | ||
] | ||
|
||
-- | We want to test 'isValidUtf8ByteArray' with various offsets, so we insert a random | ||
-- prefix and remember its length. | ||
forAllByteArray :: (ByteArray -> Int -> Int -> ByteString -> Property) -> Property | ||
forAllByteArray prop = | ||
forAllShrink genByteString shrink $ \mainSlice -> | ||
forAllShrink arbitrary shrink $ \prefix -> | ||
let bs2ba = unShortByteString . toShort in | ||
prop (bs2ba (prefix <> mainSlice)) (B.length prefix) (B.length mainSlice) mainSlice |