[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 c10c55057cb259f6b0b86a3169c07f45671bbd6a
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Feb 2 23:47:12 2005 +0100

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

diff --git a/ChangeLog b/ChangeLog
index 244d08e..b6d5b4e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2005-02-02 16:47:12 GMT	John Goerzen <jgoerzen at complete.org>	patch-189
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-189
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/AnyDBM/StringDBM.hs
+     libsrc/MissingH/IO/HVFS.hs testsrc/AnyDBMtest.hs
+
+
 2005-02-02 16:31:52 GMT	John Goerzen <jgoerzen at complete.org>	patch-188
 
     Summary:
diff --git a/libsrc/MissingH/AnyDBM/StringDBM.hs b/libsrc/MissingH/AnyDBM/StringDBM.hs
index 4ccef9d..fe26ffb 100644
--- a/libsrc/MissingH/AnyDBM/StringDBM.hs
+++ b/libsrc/MissingH/AnyDBM/StringDBM.hs
@@ -36,7 +36,8 @@ The data is written out during a call to 'flush' or 'close'.
 
 module MissingH.AnyDBM.StringDBM (StringDBM,
                                   openStringDBM,
-                                  SystemFS(..)
+                                  SystemFS(..),
+                                  IOMode(..)
                                  )
 where
 import MissingH.AnyDBM
@@ -73,9 +74,12 @@ openStringDBM h fp WriteMode =
 openStringDBM h fp ReadWriteMode =
     -- Nothing different to start with.  Later, we emulate WriteMode.
     -- Nothing is ever read after the object is created.
-    do o <- openStringDBM h fp ReadMode
-       case o of
-              StringDBM x _ y z -> return $ StringDBM x WriteMode y z
+    do ht <- new (==) hashString
+       d <- vDoesFileExist h fp
+       if d
+          then vReadFile h fp >>= strToA ht
+          else return ()
+       return $ StringDBM ht WriteMode h fp
 
 g :: StringDBM -> HashTable String String
 g (StringDBM ht _ _ _) = ht
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index c40d062..a382cd6 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -58,7 +58,7 @@ module MissingH.IO.HVFS(-- * Implementation Classes \/ Types
                         -- * Re-exported types from other modules
                         FilePath, DeviceID, FileID, FileMode, LinkCount,
                         UserID, GroupID, FileOffset, EpochTime,
-                        
+                        IOMode
                     )
 where
 
diff --git a/testsrc/AnyDBMtest.hs b/testsrc/AnyDBMtest.hs
index da9596c..6ea6beb 100644
--- a/testsrc/AnyDBMtest.hs
+++ b/testsrc/AnyDBMtest.hs
@@ -20,14 +20,17 @@ module AnyDBMtest(mf, generic_test, tests) where
 import HUnit
 import MissingH.List
 import MissingH.IO.HVFS
+import MissingH.IO.HVFS.InstanceHelpers
 import MissingH.AnyDBM
+import MissingH.AnyDBM.StringDBM
 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
+mf :: AnyDBM a => IO b -> (b -> IO a) -> String -> (a -> Assertion) -> Test
+mf initfunc openfunc msg code =
+    TestLabel msg $ TestCase $ do i <- initfunc
+                                  h <- openfunc i
                                   finally (code h) (closeA h)
         
 infix 1 @>=?
@@ -44,8 +47,8 @@ weirdl = sort $ [("", "empty"),
                  ("v3,v4", ""),
                  ("k\0ey", "\xFF")]
 
-generic_test openfunc =
-    let f = mf openfunc in
+generic_test initfunc openfunc =
+    let f = mf initfunc openfunc in
         [
          f "empty" $ \h -> do [] @>=? keysA h
                               [] @>=? valuesA h
@@ -70,9 +73,13 @@ generic_test openfunc =
                                    deleteall h
         ]
 
-test_hashtable = generic_test $ ((new (==) hashString)::IO (HashTable String String))
+test_hashtable = generic_test (return ())
+                  (\_ -> ((new (==) hashString)::IO (HashTable String String)))
+test_stringdbm = generic_test (newMemoryVFS [])
+                   (\f -> openStringDBM f "/foo" ReadWriteMode)
 
-tests = TestList [TestLabel "HashTable" (TestList test_hashtable)
+tests = TestList [TestLabel "HashTable" (TestList test_hashtable),
+                  TestLabel "StringDBM" (TestList test_stringdbm)
                  ]
 
 

-- 
haskell-testpack