[commit: ghc] master: runghc: Fix interaction of stdin and --ghc-args (ec4af3f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ec4af3fbcd47ca3af1727e70fa20e7cb8db0fb41/ghc

>---------------------------------------------------------------

commit ec4af3fbcd47ca3af1727e70fa20e7cb8db0fb41
Author: John Lenz <lenz at math.uic.edu>
Date:   Tue Jan 7 07:21:23 2014 -0600

    runghc: Fix interaction of stdin and --ghc-args
    
    When reading the program from standard input, runghc did not properly
    handle the --ghc-arg= escape for arguments to ghc which do not start
    with a dash, since arguments were processed twice and the first time the
    --ghc-arg= was stripped.  Now arguments are only processed once.  For
    backwards compatibility, a prefix of --ghc-arg=--ghc-arg= is allowed
    since this prefix will work on both old and new versions of ghc.
    
    This fixes #8601
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

ec4af3fbcd47ca3af1727e70fa20e7cb8db0fb41
 utils/runghc/runghc.hs |   20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 1673e7b..5280cb3 100644
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -48,14 +48,14 @@ main = do
     case parseRunGhcFlags args of
         (Help, _) -> printUsage
         (ShowVersion, _) -> printVersion
-        (RunGhcFlags (Just ghc), args') -> doIt ghc args'
+        (RunGhcFlags (Just ghc), args') -> uncurry (doIt ghc) $ getGhcArgs args'
         (RunGhcFlags Nothing, args') -> do
             mbPath <- getExecPath
             case mbPath of
                 Nothing  -> dieProg ("cannot find ghc")
                 Just path ->
                     let ghc = takeDirectory (normalise path) </> "ghc"
-                    in doIt ghc args'
+                    in uncurry (doIt ghc) $ getGhcArgs args'
 
 data RunGhcFlags = RunGhcFlags (Maybe FilePath) -- GHC location
                  | Help -- Print help text
@@ -96,9 +96,11 @@ printUsage = do
     putStrLn "    --help                Print this usage information"
     putStrLn "    --version             Print version number"
 
-doIt :: String -> [String] -> IO ()
-doIt ghc args = do
-    let (ghc_args, rest) = getGhcArgs args
+doIt :: String -- ^ path to GHC
+     -> [String] -- ^ GHC args
+     -> [String] -- ^ rest of the args
+     -> IO ()
+doIt ghc ghc_args rest = do
     case rest of
         [] -> do
            -- behave like typical perl, python, ruby interpreters:
@@ -110,7 +112,7 @@ doIt ghc args = do
              $ \(filename,h) -> do
                  getContents >>= hPutStr h
                  hClose h
-                 doIt ghc (ghc_args ++ [filename])
+                 doIt ghc ghc_args [filename]
         filename : prog_args -> do
             -- If the file exists, and is not a .lhs file, then we
             -- want to treat it as a .hs file.
@@ -136,7 +138,11 @@ getGhcArgs args
                               (xs, "--":ys) -> (xs, ys)
                               (xs, ys)      -> (xs, ys)
    in (map unescape ghcArgs, otherArgs)
-    where unescape ('-':'-':'g':'h':'c':'-':'a':'r':'g':'=':arg) = arg
+    where unescape ('-':'-':'g':'h':'c':'-':'a':'r':'g':'=':arg) =
+                case arg of
+                    -- Bug #8601: allow --ghc-arg=--ghc-arg= as a prefix as well for backwards compatibility
+                    ('-':'-':'g':'h':'c':'-':'a':'r':'g':'=':arg') -> arg'
+                    _ -> arg
           unescape arg = arg
 
 pastArgs :: String -> Bool