From: ross <unknown>
Date: Fri, 3 Dec 2004 14:08:07 +0000 (+0000)
Subject: [project @ 2004-12-03 14:08:07 by ross]
X-Git-Tag: nhc98-1-18-release~166
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=23b82c143e16abb767ba9e85db7fe84e26d32781;p=ghc-base.git

[project @ 2004-12-03 14:08:07 by ross]
added a simple-minded implementation of rawSystem for non-GHC implementations.
Also re-instated the doc comment that rawSystem lost in its travels.
---

diff --git a/System/Cmd.hs b/System/Cmd.hs
index ceb0bbe..1eaaf78 100644
--- a/System/Cmd.hs
+++ b/System/Cmd.hs
@@ -14,16 +14,15 @@
 
 module System.Cmd
     ( system,        -- :: String -> IO ExitCode
-#ifdef __GLASGOW_HASKELL__
       rawSystem,     -- :: FilePath -> [String] -> IO ExitCode
-#endif
     ) where
 
 import Prelude
 
+import System.Exit 	( ExitCode )
+
 #ifdef __GLASGOW_HASKELL__
 import System.Process
-import System.Exit 	( ExitCode )
 import GHC.IOBase	( ioException, IOException(..), IOErrorType(..) )
 #endif
 
@@ -64,9 +63,36 @@ system "" = ioException (IOError Nothing InvalidArgument "system" "null command"
 system cmd = do
   p <- runCommand cmd
   waitForProcess p
+#endif  /* __GLASGOW_HASKELL__ */
 
+{-|
+The computation @'rawSystem' cmd args@ runs the operating system command
+@cmd@ in such a way that it receives as arguments the @args@ strings
+exactly as given, with no funny escaping or shell meta-syntax expansion.
+It will therefore behave more portably between operating systems than 'system'.
+
+The return codes and possible failures are the same as for 'system'.
+-}
 rawSystem :: String -> [String] -> IO ExitCode
+#ifdef __GLASGOW_HASKELL__
 rawSystem cmd args = do
   p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing
   waitForProcess p
-#endif  /* __GLASGOW_HASKELL__ */
+#else /* ! __GLASGOW_HASKELL__ */
+-- crude fallback implementation: could do much better than this under Unix
+rawSystem cmd args = system (unwords (map translate (cmd:args)))
+
+translate :: String -> String
+#if defined(mingw32_TARGET_OS)
+-- copied from System.Process (qv)
+translate str = '"' : snd (foldr escape (True,"\"") str)
+  where	escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
+	escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
+	escape '\\' (False, str) = (False, '\\' : str)
+	escape c    (b,     str) = (False, c : str)
+#else /* ! mingw32_TARGET_OS */
+translate str = '\'' : foldr escape "'" str
+  where	escape '\'' cs = '\'' : '\\' : '\'' : '\'' : cs
+	escape c    cs = c : cs
+#endif /* ! mingw32_TARGET_OS */
+#endif /* ! __GLASGOW_HASKELL__ */