on master help sign in
Attempt to test decoding error paths a bit
bb3c24cBryan O'Sullivan
tests/Properties.hs+13−3
@@ -21,7 +21,7 @@ import qualified Data.Text.Lazy.IO as TL
21import qualified Data.Text.Lazy.Builder as TB
21import qualified Data.Text.Lazy.Builder as TB
22import qualified Data.Text.Encoding as E
22import qualified Data.Text.Encoding as E
23import Data.Text.Encoding.Error
23import Data.Text.Encoding.Error
24−import Control.Exception (SomeException, bracket, evaluate, try)
24+import Control.Exception (SomeException, bracket, catch, evaluate, try)
25import Data.Text.Foreign
25import Data.Text.Foreign
26import qualified Data.Text.Fusion as S
26import qualified Data.Text.Fusion as S
27import qualified Data.Text.Fusion.Common as S
27import qualified Data.Text.Fusion.Common as S
@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.Encoding as EL
30import qualified Data.Text.Lazy.Fusion as SL
30import qualified Data.Text.Lazy.Fusion as SL
31import qualified Data.Text.UnsafeShift as U
31import qualified Data.Text.UnsafeShift as U
32import qualified Data.List as L
32import qualified Data.List as L
33−import Prelude hiding (replicate)
33+import Prelude hiding (catch, replicate)
34import System.IO
34import System.IO
35import System.IO.Unsafe (unsafePerformIO)
35import System.IO.Unsafe (unsafePerformIO)
36import Test.Framework (defaultMain, testGroup)
36import Test.Framework (defaultMain, testGroup)
@@ -93,9 +93,19 @@ instance CoArbitrary Word8 where
93instance Arbitrary DecodeErr where
93instance Arbitrary DecodeErr where
94 arbitrary = oneof [ return $ DE "lenient" lenientDecode
94 arbitrary = oneof [ return $ DE "lenient" lenientDecode
95 , return $ DE "ignore" ignore
95 , return $ DE "ignore" ignore
96+ , return $ DE "strict" strictDecode
96 , DE "replace" `fmap` arbitrary ]
97 , DE "replace" `fmap` arbitrary ]
97
98
99+-- This is a poor attempt to ensure that the error handling paths on
100+-- decode are exercised in some way. Proper testing would be rather
101+-- more involved.
102+t_utf8_err (DE _ de) bs = monadicIO $ do
98−t_utf8_err (DE _ de) bs = T.length (E.decodeUtf8With de bs) >= 0
103+ l <- run $ let len = T.length (E.decodeUtf8With de bs)
104+ in (len `seq` return (Right len)) `catch`
105+ (\(e::UnicodeException) -> return (Left e))
106+ case l of
107+ Left err -> assert $ length (show err) >= 0
108+ Right n -> assert $ n >= 0
99
109
100class Stringy s where
110class Stringy s where
101 packS :: String -> s
111 packS :: String -> s