[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

John Goerzen jgoerzen at complete.org
Fri Apr 23 14:49:30 UTC 2010


The following commit has been merged in the master branch:
commit ab62349a5b460c605d72448d9bde33f708236ffc
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Dec 4 03:32:24 2004 +0100

    Wrote unit tests for CRC32 module
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-13)

diff --git a/ChangeLog b/ChangeLog
index 9ec4818..fcc3df6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-03 20:32:24 GMT	John Goerzen <jgoerzen at complete.org>	patch-13
+
+    Summary:
+      Wrote unit tests for CRC32 module
+    Revision:
+      missingh--head--0.7--patch-13
+
+
+    new files:
+     testsrc/CRC32test.hs
+
+    modified files:
+     ChangeLog libsrc/MissingH/Checksum/CRC32.hs testsrc/Tests.hs
+
+
 2004-12-03 20:18:47 GMT	John Goerzen <jgoerzen at complete.org>	patch-12
 
     Summary:
diff --git a/libsrc/MissingH/Checksum/CRC32.hs b/libsrc/MissingH/Checksum/CRC32.hs
index c876cfb..fad25d4 100644
--- a/libsrc/MissingH/Checksum/CRC32.hs
+++ b/libsrc/MissingH/Checksum/CRC32.hs
@@ -16,47 +16,37 @@
 
 -- 	$Id: crc32.hs,v 1.2 2003/03/24 00:08:55 eris Exp $	
 
-module Main where
+{- |
+   Module     : MissingH.Checksum.CRC32
+   Copyright  : Copyright (C) 2002 HardCore SoftWare, Doug Hoyte
+   License    : GNU GPL
 
-import Array
-import Bits
-import IO
-import System (getArgs)
-import Word
+   Maintainer : John Goerzen, 
+   Maintainer : jgoerzen at complete.org
+   Stability  : provisional
+   Portability: portable
 
+Configuration file parsing, generation, and manipulation
 
-main :: IO ()
-main  = do args <- getArgs
-           case args of
-             (f:fs) -> procFiles args
-             _      -> procStdin
+Copyright (c) 2002 HardCore SoftWare, Doug Hoyte
+-}
 
+{-
+Modified December, 2004 by John Goerzen:
+ * Integrate with MissingH
+ * Removed code we don't need in a library
+ * Updated things that didn't compile any more
+-}
 
-procStdin :: IO ()
-procStdin  = do contents <- getContents
-                dispCRC (crc32 contents) (length contents) ""
-
-
-procFiles       :: [String] -> IO ()
-procFiles []     = do return ()
-procFiles (f:fs) = do handle <- openFile f ReadMode
-                      contents <- hGetContents handle
-                      dispCRC (crc32 contents) (length contents) f
-                      hClose handle
-                      procFiles fs
-
-
-dispCRC              :: Word32 -> Int -> String -> IO ()
-dispCRC crc len fname = do putStr $ show crc
-                           putStr " "
-                           putStr $ show len
-                           putStr " "
-                           putStr (fname ++ "\n")
+module MissingH.Checksum.CRC32 where
 
+import Data.Array
+import Data.Bits
+import Data.Word
 
 iter_crc32       :: Word32 -> Char -> Word32
 iter_crc32 sum ch = (sum `shiftL` 8) `xor`
-                    crctab ! word32ToInt ((sum `shiftR` 24) `xor`
+                    crctab ! fromIntegral ((sum `shiftR` 24) `xor`
                     (fromIntegral (fromEnum ch)))
 
 
@@ -64,7 +54,7 @@ calc_crc32            :: [Char] -> Word32 -> Word32 -> Word32
 calc_crc32 []     ck 0 = ck `xor` 0xFFFFFFFF
 calc_crc32 []     ck l = calc_crc32
                            []
-                           (iter_crc32 ck (toEnum $ word32ToInt (l .&. 0xFF)))
+                           (iter_crc32 ck (toEnum $ fromIntegral (l .&. 0xFF)))
                            (l `shiftR` 8)
 calc_crc32 (x:xs) ck l = calc_crc32 xs (iter_crc32 ck x) (l+1)
 
diff --git a/testsrc/Pathtest.hs b/testsrc/CRC32test.hs
similarity index 61%
copy from testsrc/Pathtest.hs
copy to testsrc/CRC32test.hs
index b020fb7..1a3f729 100644
--- a/testsrc/Pathtest.hs
+++ b/testsrc/CRC32test.hs
@@ -1,4 +1,4 @@
-{- arch-tag: Path tests main file
+{- arch-tag: Tests for CRC-32 module
 Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
 
 This program is free software; you can redistribute it and/or modify
@@ -16,20 +16,21 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 
-module Pathtest(tests) where
+module CRC32test(tests) where
 import HUnit
-import MissingH.Path
+import MissingH.Checksum.CRC32
 
-test_splitExt =
-    let f inp exp = TestCase $ exp @=? splitExt inp in
+test_crc32 =
+    let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp (crc32 inp) in
         [
-         f "" ("", "")
-        ,f "/usr/local" ("/usr/local", "")
-        ,f "../foo.txt" ("../foo", ".txt")
-        ,f "../bar.txt.gz" ("../bar.txt", ".gz")
-        ,f "foo.txt/bar" ("foo.txt/bar", "")
-        ,f "foo.txt/bar.bz" ("foo.txt/bar", ".bz")
+         f "Empty" "" 4294967295,
+         f "1" "1" 433426081,
+         f "some numbers" "153141341309874102987412" 2083856642,
+         f "Some text" "This is a test of the crc32 thing\n" 2449124888
+
         ]
 
-tests = TestList [TestLabel "splitExt" (TestList test_splitExt)
-                 ]
\ No newline at end of file
+tests = TestList [TestLabel "crc32" (TestList test_crc32)
+
+                 ]
+
diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs
index 22bbd91..20c7db5 100644
--- a/testsrc/Tests.hs
+++ b/testsrc/Tests.hs
@@ -30,6 +30,7 @@ import qualified Network.FTP.Parsertest
 import qualified Eithertest
 import qualified ConfigParser.Parsertest
 import qualified ConfigParser.Maintest
+import qualified CRC32test
 
 test1 = TestCase ("x" @=? "x")
 
@@ -44,6 +45,7 @@ tests = TestList [TestLabel "test1" test1,
                  TestLabel "Printftest" Printftest.tests,
                  TestLabel "Eithertest" Eithertest.tests,
                  TestLabel "ConfigParser.RunParser" ConfigParser.Parsertest.tests,
-                 TestLabel "ConfigParser.Main" ConfigParser.Maintest.tests]
+                 TestLabel "ConfigParser.Main" ConfigParser.Maintest.tests,
+                 TestLabel "CRC32test" CRC32test.tests]
 
 

-- 
haskell-testpack



More information about the Pkg-haskell-commits mailing list