[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 438a123bc5cb157f2db144aef79b32e6b2fc149f
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Dec 21 03:54:54 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index ffa46e4..f2c4fe5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-20 20:54:54 GMT	John Goerzen <jgoerzen at complete.org>	patch-106
+
+    Summary:
+      Checkpointing, compiles
+    Revision:
+      missingh--head--0.7--patch-106
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS.hs
+     libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+
+
 2004-12-20 20:44:29 GMT	John Goerzen <jgoerzen at complete.org>	patch-105
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index e418110..9733eda 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -175,6 +175,7 @@ class HVFS a where
     vRemoveDirectory fs _ = eh fs "vRemoveDirectory"
     vRemoveFile fs _ = eh fs "vRemoveFile"
     vRenameFile fs _ _ = eh fs "vRenameFile"
+    vRenameDirectory fs _ _ = eh fs "vRenameDirectory"
     vCreateSymbolicLink fs _ _ = eh fs "vCreateSymbolicLink"
     vReadSymbolicLink fs _ = eh fs "vReadSymbolicLink"
     vCreateLink fs _ _ = eh fs "vCreateLink"
diff --git a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
index 8282ed3..eba70bf 100644
--- a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+++ b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
@@ -62,7 +62,7 @@ data MemoryEntry = MemoryDirectory [MemoryNode]
                  | MemoryFile String
 data MemoryVFS = MemoryVFS 
                { content :: IORef [MemoryNode],
-                 cwd :: IORef String
+                 cwd :: IORef FilePath
                }
 
 -- | Create a new 'MemoryVFS' object from an existing tree.
@@ -113,11 +113,26 @@ findMelem x path =
 getMelem :: MemoryVFS -> String -> IO MemoryEntry
 getMelem x s = 
     do base <- readIORef $ cwd x
-       case secureAbsNormPath base s of
+       case absNormPath base s of
            Nothing -> fail $ "Trouble normalizing path " ++ s
            Just newpath -> findMelem x newpath
 
-{-                       
 instance HVFS MemoryVFS where
     vGetCurrentDirectory x = readIORef $ cwd x
--}
\ No newline at end of file
+    vSetCurrentDirectory x fp =
+        do curpath <- vGetCurrentDirectory x
+           -- Make sure new dir is valid
+           newdir <- getMelem x fp
+           case newdir of 
+               (MemoryFile _) -> fail $ "Attempt to cwd to non-directory " ++ fp
+               (MemoryDirectory _) -> 
+                   case absNormPath curpath fp of
+                       Nothing -> fail $ "Bad internal error"
+                       Just y -> writeIORef (cwd x) y
+    vGetFileStatus x fp = 
+        do elem <- getMelem x fp
+           case elem of
+                     (MemoryFile _) -> return $ HVFSStatEncap $
+                                             SimpleStat {isFile = True}
+                     (MemoryDirectory _) -> return $ HVFSStatEncap $
+                                             SimpleStat {isFile = False}

-- 
haskell-testpack