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

[John Goerzen]

The following commit has been merged in the master branch:
commit db52f76d7fa75539445929586f902e3d579dba89
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Feb 2 23:31:52 2005 +0100

    Checkpointing AnyDBM testing
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-188)

diff --git a/ChangeLog b/ChangeLog
index d196d34..244d08e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2005-02-02 16:31:52 GMT	John Goerzen <jgoerzen at complete.org>	patch-188
+
+    Summary:
+      Checkpointing AnyDBM testing
+    Revision:
+      missingh--head--0.7--patch-188
+
+
+    new files:
+     testsrc/AnyDBMtest.hs
+
+    modified files:
+     ChangeLog libsrc/MissingH/AnyDBM.hs testsrc/Tests.hs
+
+
 2005-02-02 04:03:46 GMT	John Goerzen <jgoerzen at complete.org>	patch-187
 
     Summary:
diff --git a/libsrc/MissingH/AnyDBM.hs b/libsrc/MissingH/AnyDBM.hs
index 2cd5b76..56905ed 100644
--- a/libsrc/MissingH/AnyDBM.hs
+++ b/libsrc/MissingH/AnyDBM.hs
@@ -147,7 +147,8 @@ strFromA h = do l <- toListA h
                 return (strFromAL l)
 
 instance AnyDBM (HashTable String String) where
-    insertA = insert
+    insertA h k v = do delete h k
+                       insert h k v
     deleteA = delete
     lookupA = lookup
     toListA = toList
diff --git a/testsrc/AnyDBMtest.hs b/testsrc/AnyDBMtest.hs
new file mode 100644
index 0000000..da9596c
--- /dev/null
+++ b/testsrc/AnyDBMtest.hs
@@ -0,0 +1,79 @@
+{- arch-tag: AnyDBM tests main file
+Copyright (C) 2004-2005 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+module AnyDBMtest(mf, generic_test, tests) where
+import HUnit
+import MissingH.List
+import MissingH.IO.HVFS
+import MissingH.AnyDBM
+import Data.HashTable
+import Data.List(sort)
+import Control.Exception(finally)
+
+mf :: AnyDBM a => IO a -> String -> (a -> Assertion) -> Test
+mf openfunc msg code =
+    TestLabel msg $ TestCase $ do h <- openfunc
+                                  finally (code h) (closeA h)
+        
+infix 1 @>=?
+(@>=?) :: (Eq a, Show a) => a -> IO a -> Assertion
+(@>=?) exp res = do r <- res
+                    exp @=? r
+
+deleteall h = do k <- keysA h
+                 mapM_ (deleteA h) k
+                 [] @>=? keysA h
+
+weirdl = sort $ [("", "empty"), 
+                 ("foo\nbar", "v1\0v2"),
+                 ("v3,v4", ""),
+                 ("k\0ey", "\xFF")]
+
+generic_test openfunc =
+    let f = mf openfunc in
+        [
+         f "empty" $ \h -> do [] @>=? keysA h
+                              [] @>=? valuesA h
+                              [] @>=? toListA h
+                              Nothing @>=? lookupA h "foo"
+                     
+        ,f "basic" $ \h -> do insertA h "key" "value"
+                              (Just "value") @>=? lookupA h "key"
+                              [("key", "value")] @>=? toListA h
+                              insertA h "key" "v2"
+                              [("key", "v2")] @>=? toListA h
+                              deleteA h "key"
+                              [] @>=? toListA h
+        ,f "mult" $ \h -> do insertListA h [("1", "2"), ("3", "4"), ("5", "6")]
+                             [("1", "2"), ("3", "4"), ("5", "6")] @>=? 
+                                (toListA h >>= return . sort)
+                             ["1", "3", "5"] @>=? (keysA h >>= return . sort)
+                             ["2", "4", "6"] @>=? (valuesA h >>= return . sort)
+                             deleteall h
+        ,f "weirdchars" $ \h -> do insertListA h weirdl
+                                   weirdl @>=? (toListA h >>= return . sort)
+                                   deleteall h
+        ]
+
+test_hashtable = generic_test $ ((new (==) hashString)::IO (HashTable String String))
+
+tests = TestList [TestLabel "HashTable" (TestList test_hashtable)
+                 ]
+
+
+
diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs
index ba9862e..f8f50a8 100644
--- a/testsrc/Tests.hs
+++ b/testsrc/Tests.hs
@@ -21,6 +21,7 @@ import HUnit
 import qualified MIMETypestest
 import qualified Listtest
 import qualified FiniteMaptest
+import qualified AnyDBMtest
 import qualified Pathtest
 import qualified Strtest
 import qualified IOtest
@@ -44,6 +45,7 @@ tests = TestList [TestLabel "test1" test1,
                  TestLabel "Str" Strtest.tests,
                  TestLabel "Time" Timetest.tests,
                  TestLabel "FiniteMap" FiniteMaptest.tests,
+                 TestLabel "AnyDBM" AnyDBMtest.tests,
                  TestLabel "Path" Pathtest.tests,
                  TestLabel "HVIO" HVIOtest.tests,
                  TestLabel "HVFS" HVFStest.tests,

-- 
haskell-testpack