Could the parties involved with the quoting issue please test the
following patch? It doesn't use an additional shell for starting
sub-tasks and does no additional quoting so that quoting remains
unaffected, i.e. testing with OpenGL shows that the double quotes
are indeed passed through. Sven, do you have time to verify this?
*** C pre-processor
gcc -E -undef -traditional -v -I . -I include -I
/usr/tmp/fptools/libraries/base/include -I /usr/tmp/fptools/ghc/includes
-D__HASKELL1__=5 -D__GLASGOW_HASKELL__=601 -D__HASKELL98__ -D__CONCURRENT_HASKELL__
-DCALLCONV=ccall -DGET_PROC_ADDRESS="glXGetProcAddressARB"
-DDONT_WANT_WIN32_DLL_SUPPORT -x c Graphics/Rendering/OpenGL/GL/BasicTypes.hs -o
/tmp/ghc70692.hscpp
It works successfully in all 3 stages and in the libraries, but I'm
not sure if I missed somebody sneaking in any
Option "-foo -bar"
along the more obscure paths!
Perhaps I should add a sanity check to 'showOpt' which will print
a warning if it encounters " -" anywhere in the string until 6.2?
'ghc -v' will show the arguments with interspersed spaces, so you
cannot really tell if there's a quote in the argument or not -- but
it means you can still cut&paste sub-tasks from -v. It might be
sensible to surround *only* the arguments in the debugging output
with single quotes, so that perpetrators can be spotted.
Mingw is unaffected, but it might be worth seeing if now both cases
boil down to one.
Volker
--
http://www-i2.informatik.rwth-aachen.de/stolz/ *** PGP *** S/MIME
rage against the finite state machine
? autom4te.cache
? compiler/.depend-3
? compiler/stage3
? driver/stamp-pkg-conf-OpenGL
? driver/ghc/ghc-6.1
? driver/ghci/ghci-6.1
? rts/log
? rts/gmp/.deps
? rts/gmp/.libs
? rts/gmp/Makefile
? rts/gmp/config.cache
? rts/gmp/config.m4
? rts/gmp/config.status
? rts/gmp/gmp-mparam.h
? rts/gmp/libgmp.la
? rts/gmp/libtool
? rts/gmp/stamp-h
? rts/gmp/mpn/.libs
? rts/gmp/mpn/Makefile
? rts/gmp/mpn/add_n.asm
? rts/gmp/mpn/addmul_1.asm
? rts/gmp/mpn/bdivmod.c
? rts/gmp/mpn/bz_divrem_n.c
? rts/gmp/mpn/cmp.c
? rts/gmp/mpn/copyd.asm
? rts/gmp/mpn/copyi.asm
? rts/gmp/mpn/diveby3.asm
? rts/gmp/mpn/divrem.c
? rts/gmp/mpn/divrem_1.asm
? rts/gmp/mpn/divrem_2.c
? rts/gmp/mpn/dump.c
? rts/gmp/mpn/gcd.c
? rts/gmp/mpn/gcd_1.c
? rts/gmp/mpn/gcdext.c
? rts/gmp/mpn/get_str.c
? rts/gmp/mpn/hamdist.c
? rts/gmp/mpn/inlines.c
? rts/gmp/mpn/jacbase.c
? rts/gmp/mpn/libmpn.la
? rts/gmp/mpn/lshift.asm
? rts/gmp/mpn/mod_1.asm
? rts/gmp/mpn/mod_1_rs.c
? rts/gmp/mpn/mul.c
? rts/gmp/mpn/mul_1.asm
? rts/gmp/mpn/mul_basecase.asm
? rts/gmp/mpn/mul_fft.c
? rts/gmp/mpn/mul_n.c
? rts/gmp/mpn/perfsqr.c
? rts/gmp/mpn/popcount.c
? rts/gmp/mpn/pre_mod_1.c
? rts/gmp/mpn/random.c
? rts/gmp/mpn/random2.c
? rts/gmp/mpn/rshift.asm
? rts/gmp/mpn/sb_divrem_mn.c
? rts/gmp/mpn/scan0.c
? rts/gmp/mpn/scan1.c
? rts/gmp/mpn/set_str.c
? rts/gmp/mpn/sqr_basecase.c
? rts/gmp/mpn/sqrtrem.c
? rts/gmp/mpn/sub_n.asm
? rts/gmp/mpn/submul_1.asm
? rts/gmp/mpn/tdiv_qr.c
? rts/gmp/mpn/udiv.asm
? rts/gmp/mpn/umul.asm
? rts/gmp/mpz/.libs
? rts/gmp/mpz/Makefile
? rts/gmp/mpz/libmpz.la
? rts/gmp/mpz/mul_si.c
? rts/gmp/mpz/mul_ui.c
? utils/genapply/genapply
? utils/ghc-pkg/ghc-pkg-6.1
Index: compiler/main/SysTools.lhs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/main/SysTools.lhs,v
retrieving revision 1.88
diff -u -r1.88 SysTools.lhs
--- compiler/main/SysTools.lhs 25 May 2003 20:54:18 -0000 1.88
+++ compiler/main/SysTools.lhs 3 Jun 2003 10:46:30 -0000
@@ -81,6 +81,7 @@
openFile, hPutChar, hPutStrLn, hPutStr, hClose, hFlush,
IOMode(..),
stderr )
import Directory ( doesFileExist, removeFile )
+import List ( intersperse )
#include "../includes/config.h"
@@ -93,8 +94,12 @@
#ifndef mingw32_HOST_OS
#if __GLASGOW_HASKELL__ > 504
import qualified System.Posix.Internals
+import System.Posix.Process ( executeFile, getProcessStatus, forkProcess,
ProcessStatus(..))
+import System.Posix.Signals ( installHandler, sigCHLD, Handler(..) )
#else
import qualified Posix
+import Posix ( executeFile, getProcessStatus, forkProcess, ProcessStatus(..),
installHandler,
+ sigCHLD, Handler(..) )
#endif
#else /* Must be Win32 */
import List ( isPrefixOf )
@@ -190,7 +195,7 @@
\begin{code}
GLOBAL_VAR(v_Pgm_L, error "pgm_L", String) -- unlit
-GLOBAL_VAR(v_Pgm_P, error "pgm_P", String) -- cpp
+GLOBAL_VAR(v_Pgm_P, error "pgm_P", (String,[Option])) -- cpp
GLOBAL_VAR(v_Pgm_F, error "pgm_F", String) -- pp
GLOBAL_VAR(v_Pgm_c, error "pgm_c", String) -- gcc
GLOBAL_VAR(v_Pgm_m, error "pgm_m", String) -- asm code mangler
@@ -374,7 +379,9 @@
#endif
-- cpp is derived from gcc on all platforms
- ; let cpp_path = gcc_path ++ " -E " ++ cRAWCPP_FLAGS
+ -- HACK, see setPgmP below. We keep 'words' here to remember to fix
+ -- Config.hs one day.
+ ; let cpp_path = (gcc_path, (Option "-E"):(map Option (words cRAWCPP_FLAGS)))
-- For all systems, copy and remove are provided by the host
-- system; architecture-specific stuff is done when building Config.hs
@@ -431,7 +438,9 @@
\begin{code}
setPgmL = writeIORef v_Pgm_L
-setPgmP = writeIORef v_Pgm_P
+-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
+-- Config.hs should really use Option.
+setPgmP arg = let (pgm:args) = words arg in writeIORef v_Pgm_P (pgm,map Option args)
setPgmF = writeIORef v_Pgm_F
setPgmc = writeIORef v_Pgm_c
setPgmm = writeIORef v_Pgm_m
@@ -513,9 +522,10 @@
showOptions :: [Option] -> String
showOptions ls = unwords (map (quote.showOpt) ls)
- where
- showOpt (FileOption pre f) = pre ++ dosifyPath f
- showOpt (Option s) = s
+
+showOpt (FileOption pre f) = pre ++ dosifyPath f
+showOpt (Option "") = ""
+showOpt (Option s) = s
\end{code}
@@ -533,8 +543,8 @@
runSomething "Literate pre-processor" p args
runCpp :: [Option] -> IO ()
-runCpp args = do p <- readIORef v_Pgm_P
- runSomething "C pre-processor" p args
+runCpp args = do (p,baseArgs) <- readIORef v_Pgm_P
+ runSomething "C pre-processor" p (baseArgs ++ args)
runPp :: [Option] -> IO ()
runPp args = do p <- readIORef v_Pgm_F
@@ -699,21 +709,31 @@
-> IO ()
runSomething phase_name pgm args
- = traceCmd phase_name cmd_line $
- do {
+ = traceCmd phase_name (concat (intersperse " " (pgm:quoteargs))) $
+ do
#ifndef mingw32_HOST_OS
- exit_code <- system cmd_line
+ installHandler sigCHLD Ignore Nothing
+ mpid <- forkProcess
+ exit_code <- case mpid of
+ Nothing -> do -- Child
+ executeFile pgm True quoteargs Nothing
+ exitWith (ExitFailure 127)
+ -- NOT REACHED
+ return ExitSuccess
+ Just child -> do -- Parent
+ Just (Exited res) <- getProcessStatus True False child
+ return res
#else
exit_code <- rawSystem cmd_line
#endif
- ; if exit_code /= ExitSuccess
- then throwDyn (PhaseFailed phase_name exit_code)
- else return ()
- }
+ when (exit_code /= ExitSuccess)
+ $ throwDyn (PhaseFailed phase_name exit_code)
+ return ()
where
-- The pgm is already in native format (appropriate dir separators)
- cmd_line = pgm ++ ' ':showOptions args
+ cmd_line = pgm ++ ' ':showOptions args
-- unwords (pgm : dosifyPaths (map quote args))
+ quoteargs = filter (not.null) (map showOpt args)
traceCmd :: String -> String -> IO () -> IO ()
-- a) trace the command (at two levels of verbosity)
@@ -733,7 +753,7 @@
}}
where
handle_exn verb exn = do { when (verb >= 2) (hPutStr stderr "\n")
- ; when (verb >= 3) (hPutStrLn stderr ("Failed: " ++
cmd_line))
+ ; when (verb >= 3) (hPutStrLn stderr ("Failed: " ++
cmd_line ++ (show exn)))
; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
\end{code}
