From 0d760962f30b9c59436d498eb3ee4d4aee9bc9c8 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 30 Apr 1998 19:22:29 +0000
Subject: [PATCH] [project @ 1998-04-30 19:22:29 by sof] Working implementation
of getDirectoryContents (needed with 3.01 or earlier.)
---
ghc/compiler/utils/DirUtils.lhs | 57 +++++++++++++++++++++++++++++++++
1 file changed, 57 insertions(+)
create mode 100644 ghc/compiler/utils/DirUtils.lhs
diff --git a/ghc/compiler/utils/DirUtils.lhs b/ghc/compiler/utils/DirUtils.lhs
new file mode 100644
index 000000000000..dffd408e9b1f
--- /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}
--
GitLab