Fix #21889, GHCi misbehaves with Ctrl-C on Windows

On Windows, we create multiple levels of wrappers for GHCi which ultimately
execute ghc --interactive. In order to handle console events properly, each of
these wrappers must call FreeConsole() in order to hand off event processing to
the child process. See #14150.

In addition to this, FreeConsole must only be called from interactive processes (#13411).

This commit makes two changes to fix this situation:

1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole`
   if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi.
2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather
   than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`:

   Before:
   ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe

   After:
   ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe

(cherry picked from commit 3bbde95769aa2986adb8bef7d718aa0e8731f9fd)

1 files changed, 12 insertions, 5 deletions

diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 24d9217cce..578572b21f 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -163,7 +163,7 @@ bindistRules = do
             -- 2. Either make a symlink for the unversioned version or
             -- a wrapper script on platforms (windows) which don't support symlinks.
             if windowsHost
-              then createVersionWrapper version_prog unversioned_install_path
+              then createVersionWrapper pkg version_prog unversioned_install_path
               else liftIO $ do
                 -- Use the IO versions rather than createFileLink because
                 -- we need to create a relative symlink.
@@ -180,8 +180,8 @@ bindistRules = do
                     bindistFilesDir -/- "bin" -/- "runhaskell" ++ "-" ++ version ++ ext
               if windowsHost
                 then do
-                  createVersionWrapper version_prog unversioned_runhaskell_path
-                  createVersionWrapper version_prog versioned_runhaskell_path
+                  createVersionWrapper pkg version_prog unversioned_runhaskell_path
+                  createVersionWrapper pkg version_prog versioned_runhaskell_path
                 else liftIO $ do
                   -- Unversioned
                   IO.removeFile unversioned_runhaskell_path <|> return ()
@@ -453,15 +453,22 @@ iservBins = do
 -- See Note [Two Types of Wrappers]
 
 -- | Create a wrapper script calls the executable given as first argument
-createVersionWrapper :: String -> FilePath -> Action ()
-createVersionWrapper versioned_exe install_path = do
+createVersionWrapper :: Package -> String -> FilePath -> Action ()
+createVersionWrapper pkg versioned_exe install_path = do
   ghcPath <- builderPath (Ghc CompileCWithGhc Stage2)
   top <- topDirectory
   let version_wrapper_dir = top -/- "hadrian" -/- "bindist" -/- "cwrappers"
       wrapper_files = [ version_wrapper_dir -/- file | file <- ["version-wrapper.c", "getLocation.c", "cwrapper.c"]]
+      -- If the wrapper is for an interactive process like GHCi then we need to call
+      -- FreeConsole to pass event processing to the child process
+      -- See #21889 and #14150 and #13411
+      interactive
+        | pkg == ghciWrapper = (1 :: Int)
+        | otherwise = 0
 
   cmd ghcPath (["-no-hs-main", "-o", install_path, "-I"++version_wrapper_dir
               , "-DEXE_PATH=\"" ++ versioned_exe ++ "\""
+              , "-DINTERACTIVE_PROCESS=" ++ show interactive
               ] ++ wrapper_files)
 
 {-