From: sof <unknown>
Date: Thu, 30 Apr 1998 19:22:29 +0000 (+0000)
Subject: [project @ 1998-04-30 19:22:29 by sof]
X-Git-Tag: Approx_2487_patches~754
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0d760962f30b9c59436d498eb3ee4d4aee9bc9c8;p=ghc-hetmet.git

[project @ 1998-04-30 19:22:29 by sof]
Working implementation of getDirectoryContents (needed with 3.01 or earlier.)
---

diff --git a/ghc/compiler/utils/DirUtils.lhs b/ghc/compiler/utils/DirUtils.lhs
new file mode 100644
index 0000000..dffd408
--- /dev/null
+++ b/ghc/compiler/utils/DirUtils.lhs
@@ -0,0 +1,57 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1998
+%
+\section[DirUtils]{Directory functions}
+
+\begin{code}
+{-# OPTIONS -#include <dirent.h> #-}
+module DirUtils
+       (
+	getDirectoryContents
+       ) where
+
+#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ >= 302
+import Directory
+#else
+
+#if __GLASGOW_HASKELL__ >= 300
+import PrelPack   ( unpackNBytesST )
+#else
+import PackBase   ( unpackNBytesST )
+#endif
+import PrimPacked ( strLength )
+import GlaExts    ( stToIO )
+import Addr	  ( Addr )
+
+\end{code}
+
+The implementation of Directory.getDirectoryContents that ships
+with ghc-X ( X<=301) is wrong (the C stub fails to allocate
+space for the terminating NUL for each directory entry name.)
+
+To counter for this, we supply a working version here, which will
+be nuked once we can assume that ghc-3.02 or later is used to 
+compile the compiler sources.
+
+\begin{code}
+getDirectoryContents :: String -> IO [String]
+getDirectoryContents path = do
+    dir <- _ccall_ opendir path
+    if dir == ``NULL'' 
+	then fail (userError ("DirUtils.getDirectoryContents: couldn't open "++ path))
+     	else loop dir
+  where
+    loop :: Addr -> IO [String]
+    loop dir  = do
+      dirent_ptr <- _ccall_ readdir dir
+      if (dirent_ptr::Addr) == ``NULL'' 
+       then do
+          _ccall_ closedir dir
+	  return [] 
+       else do
+          str     <- _casm_ `` %r=(char*)((struct dirent*)%0)->d_name; '' dirent_ptr
+	  entry   <- stToIO (unpackNBytesST str (strLength str))
+          entries <- loop dir
+          return (entry:entries)
+#endif
+\end{code}