Also test lazy encoding and decoding
darcs-hash:20080119232950-a4fee-9fe600c6237f05b2e140733483f9b637a3c12812
This commit is contained in:
parent
59a8526727
commit
71c645029b
@ -4,7 +4,8 @@ module Test.Tester where
|
|||||||
import Data.Encoding
|
import Data.Encoding
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Data.ByteString (pack)
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import Control.Exception (catchDyn,evaluate)
|
import Control.Exception (catchDyn,evaluate)
|
||||||
|
|
||||||
data EncodingTest
|
data EncodingTest
|
||||||
@ -12,26 +13,56 @@ data EncodingTest
|
|||||||
EncodingTest enc String [Word8]
|
EncodingTest enc String [Word8]
|
||||||
| forall enc. (Encoding enc,Show enc) =>
|
| forall enc. (Encoding enc,Show enc) =>
|
||||||
DecodingError enc [Word8] DecodingException
|
DecodingError enc [Word8] DecodingException
|
||||||
|
| forall enc. (Encoding enc,Show enc) =>
|
||||||
|
EncodingError enc String EncodingException
|
||||||
|
|
||||||
instance Testable EncodingTest where
|
instance Testable EncodingTest where
|
||||||
test (EncodingTest enc src trg) = TestList
|
test (EncodingTest enc src trg) = TestList
|
||||||
[TestLabel (show enc ++ " encodable")
|
[TestLabel (show enc ++ " encodable")
|
||||||
(TestCase $ (all (encodable enc) src) @=? True)
|
(TestCase $ (all (encodable enc) src) @=? True)
|
||||||
,TestLabel (show enc ++ " encoding")
|
,TestLabel (show enc ++ " encoding (strict)")
|
||||||
(TestCase $ (encode enc src) @=? bstr)
|
(TestCase $ (encode enc src) @=? bstr)
|
||||||
|
,TestLabel (show enc ++ " encoding (lazy)")
|
||||||
|
(TestCase $ (encodeLazy enc src) @=? lbstr)
|
||||||
,TestLabel (show enc ++ " decodable")
|
,TestLabel (show enc ++ " decodable")
|
||||||
(TestCase $ (decodable enc bstr) @=? True)
|
(TestCase $ (decodable enc bstr) @=? True)
|
||||||
,TestLabel (show enc ++ " decoding")
|
,TestLabel (show enc ++ " decoding (strict)")
|
||||||
(TestCase $ (decode enc bstr) @=? src)
|
(TestCase $ (decode enc bstr) @=? src)
|
||||||
|
,TestLabel (show enc ++ " decoding (lazy)")
|
||||||
|
(TestCase $ (decodeLazy enc lbstr) @=? src)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
bstr = pack trg
|
bstr = BS.pack trg
|
||||||
|
lbstr = LBS.pack trg
|
||||||
test (DecodingError enc trg what) = TestList
|
test (DecodingError enc trg what) = TestList
|
||||||
[TestLabel (show enc ++ " not decodable") $
|
[TestLabel (show what++" not decodable in "++show enc) $
|
||||||
TestCase $ assert $ not $ decodable enc (pack trg)
|
TestCase $ assert $ not $ decodable enc (BS.pack trg)
|
||||||
,TestLabel (show enc ++ " decoding error") $ TestCase $
|
,TestLabel (show enc ++ " decoding error (strict)") $ TestCase $
|
||||||
catchDyn (do
|
catchDyn (do
|
||||||
evaluate (decode enc (pack trg) == "")
|
mapM_ evaluate (decode enc (BS.pack trg))
|
||||||
return ())
|
assertFailure "No exception thrown"
|
||||||
|
)
|
||||||
|
(\exc -> exc @=? what)
|
||||||
|
,TestLabel (show enc ++ " decoding error (lazy)") $ TestCase $
|
||||||
|
catchDyn (do
|
||||||
|
mapM_ evaluate (decodeLazy enc (LBS.pack trg))
|
||||||
|
assertFailure "No exception thrown"
|
||||||
|
)
|
||||||
|
(\exc -> exc @=? what)
|
||||||
|
]
|
||||||
|
test (EncodingError enc src what) = TestList
|
||||||
|
[TestLabel (show src ++ " not encodable in " ++ show enc) $
|
||||||
|
TestCase $ assert $ not $ all (encodable enc) src
|
||||||
|
,TestLabel (show enc ++ " encoding error (strict)") $ TestCase $
|
||||||
|
catchDyn (do
|
||||||
|
evaluate (encode enc src)
|
||||||
|
assertFailure "No exception thrown"
|
||||||
|
)
|
||||||
|
(\exc -> exc @=? what)
|
||||||
|
,TestLabel (show enc ++ " encoding error (lazy)") $ TestCase $
|
||||||
|
catchDyn (do
|
||||||
|
evaluate (encodeLazy enc src)
|
||||||
|
assertFailure "No exception thrown"
|
||||||
|
)
|
||||||
(\exc -> exc @=? what)
|
(\exc -> exc @=? what)
|
||||||
]
|
]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user