Use QuickCheck2 for tests

Ignore-this: 6737cd0c99551059dbd38ccd5c829c3f

darcs-hash:20100214220741-a4fee-595218656a3e7a18ecf2413bfdbaa04fa4add743

tests/Test/Tester.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ExistentialQuantification,ImplicitParams #-}
 module Test.Tester where
 
 import Data.Encoding
+import Data.Encoding.UTF8
 import Test.HUnit
 import Data.Word
 import Data.Char
@@ -12,6 +13,8 @@ import Test.QuickCheck hiding (Testable)
 data EncodingTest
 	= forall enc. (Encoding enc,Show enc) =>
 		EncodingTest enc String [Word8]
+	| forall enc. (Encoding enc,Show enc) =>
+		EncodingFileTest enc FilePath FilePath
 	| forall enc. (Encoding enc,Show enc) =>
 		DecodingError enc [Word8] DecodingException
 	| forall enc. (Encoding enc,Show enc) =>
@@ -27,6 +30,14 @@ instance Testable EncodingTest where
            (TestCase $ decodeStrictByteStringExplicit enc (BS.pack trg)
                          @=? Right src)
           ]
+    test (EncodingFileTest e src trg)
+        = test $ do
+            str_src <- (let ?enc = e in readFile src)
+            bsrc <- LBS.readFile src
+            str_trg <- (let ?enc = UTF8 in readFile trg)
+            str_src @?= str_trg
+            --bsrc @=? (encodeLazyByteString enc str_trg)
+            
     test (DecodingError enc src ex)
         = TestLabel (show enc ++ " decoding error")
           (TestCase $ decodeStrictByteStringExplicit enc (BS.pack src) @=? Left ex)
@@ -40,35 +51,27 @@ charGen = let
     threeByte = choose (0x010000,0x10FFFF) >>= return.chr
     in frequency [(40,ascii),(30,oneByte),(20,twoByte),(10,threeByte)]
 
-instance Arbitrary Char where
-    arbitrary = charGen
-    coarbitrary x = id
-
 instance Arbitrary Word8 where
     arbitrary = choose (0x00,0xFF::Int) >>= return.fromIntegral
-    coarbitrary x = id
 
 quickCheckEncoding :: Encoding enc => enc -> IO ()
 quickCheckEncoding e = do
   quickCheck (encodingIdentity e)
   quickCheck (decodingIdentity e)
 
-encodingIdentity :: Encoding enc => enc -> String -> Property
+encodingIdentity :: Encoding enc => enc -> Property
-encodingIdentity e str
+encodingIdentity e
-    = trivial (null str) 
+  = let gen = listOf1 (charGen `suchThat` (encodeable e))
-      $ case encoded of
+    in forAll gen (\str -> case encodeStrictByteStringExplicit e str of
-          Left err -> trivial True True
+                      Left err -> property False
-          Right res -> case decodeStrictByteStringExplicit e res of
+                      Right res -> case decodeStrictByteStringExplicit e res of
                         Left err -> property False
-                        Right res' -> property (str==res')
+                        Right res2 -> property (str==res2))
-    where
-      encoded = encodeStrictByteStringExplicit e str
 
 decodingIdentity :: Encoding enc => enc -> [Word8] -> Property
 decodingIdentity e wrd
-    = trivial (null wrd)
+    = classify (null wrd) "trivial" $ case decoded of
-      $ case decoded of
+          Left err -> label "trivial" $ property True
-          Left err -> trivial True True
           Right res -> case encodeStrictByteStringExplicit e res of
                         Left err -> property False
                         Right res' -> property (bstr==res')

tests/Test/Tests.hs

@@ -21,8 +21,10 @@ import Data.Encoding.JISX0208
 import Data.Encoding.ISO2022JP
 import Data.Encoding.GB18030
 import Data.Encoding.BootString
+import Data.Encoding.BIG5
+import Data.Encoding.CP437
 import Test.HUnit
-import Test.QuickCheck hiding (test)
+import Test.QuickCheck
 import Data.Char (ord)
 
 identityTests :: IO ()
@@ -62,6 +64,8 @@ identityTests = do
   quickCheck $ encodingIdentity punycode
   putStrLn "for GB18030"
   quickCheck $ encodingIdentity GB18030
+  putStrLn "for CP437"
+  quickCheck $ encodingIdentity CP437
 
 utf8Tests :: Test
 utf8Tests = TestList $ map test $ concat
@@ -275,3 +279,7 @@ gb18030Tests = TestList $ map test $
                         ,[0x83,0x38,0x96,0x37]
                         ,[0x84,0x31,0xA4,0x39]])
                ]
+
+big5Tests :: Test
+big5Tests = test (EncodingFileTest BIG5 "data/BIG5" "data/BIG5.UTF-8")
+