From adcf21c7530a26baf15c27ff02355fad98aea7df Mon Sep 17 00:00:00 2001
From: Henning Guenther <h.guenther@tu-bs.de>
Date: Sun, 14 Feb 2010 14:07:41 -0800
Subject: [PATCH] Use QuickCheck2 for tests

Ignore-this: 6737cd0c99551059dbd38ccd5c829c3f

darcs-hash:20100214220741-a4fee-595218656a3e7a18ecf2413bfdbaa04fa4add743
---
 tests/Test/Tester.hs | 39 +++++++++++++++++++++------------------
 tests/Test/Tests.hs  | 12 ++++++++++--
 2 files changed, 31 insertions(+), 20 deletions(-)

diff --git a/tests/Test/Tester.hs b/tests/Test/Tester.hs
index 277d435..8e60e2a 100644
--- a/tests/Test/Tester.hs
+++ b/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 e str
-    = trivial (null str) 
-      $ case encoded of
-          Left err -> trivial True True
-          Right res -> case decodeStrictByteStringExplicit e res of
+encodingIdentity :: Encoding enc => enc -> Property
+encodingIdentity e
+  = let gen = listOf1 (charGen `suchThat` (encodeable e))
+    in forAll gen (\str -> case encodeStrictByteStringExplicit e str of
+                      Left err -> property False
+                      Right res -> case decodeStrictByteStringExplicit e res of
                         Left err -> property False
-                        Right res' -> property (str==res')
-    where
-      encoded = encodeStrictByteStringExplicit e str
+                        Right res2 -> property (str==res2))
 
 decodingIdentity :: Encoding enc => enc -> [Word8] -> Property
 decodingIdentity e wrd
-    = trivial (null wrd)
-      $ case decoded of
-          Left err -> trivial True True
+    = classify (null wrd) "trivial" $ case decoded of
+          Left err -> label "trivial" $ property True
           Right res -> case encodeStrictByteStringExplicit e res of
                         Left err -> property False
                         Right res' -> property (bstr==res')
diff --git a/tests/Test/Tests.hs b/tests/Test/Tests.hs
index eb0bada..aa761dc 100644
--- a/tests/Test/Tests.hs
+++ b/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
@@ -274,4 +278,8 @@ gb18030Tests = TestList $ map test $
                         ,[0x83,0x38,0x96,0x36]
                         ,[0x83,0x38,0x96,0x37]
                         ,[0x84,0x31,0xA4,0x39]])
-               ]
\ No newline at end of file
+               ]
+
+big5Tests :: Test
+big5Tests = test (EncodingFileTest BIG5 "data/BIG5" "data/BIG5.UTF-8")
+            
\ No newline at end of file