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

4 files changed, 34 insertions, 7 deletions

diff --git a/driver/ghci/ghci-wrapper.cabal.in b/driver/ghci/ghci-wrapper.cabal.in
index 5a422aab9b..2a5ff2bb15 100644
--- a/driver/ghci/ghci-wrapper.cabal.in
+++ b/driver/ghci/ghci-wrapper.cabal.in
@@ -26,3 +26,7 @@ Executable ghci
     C-Sources:
        -- the following get copied from ../utils by hadrian
        getLocation.c isMinTTY.c cwrapper.c
+    -- We need to call the versioned ghc executable because the unversioned
+    -- GHC executable is a wrapper that doesn't call FreeConsole and so
+    -- breaks an interactive process like GHCi. See #21889, #14150 and #13411
+    CPP-Options: -DEXE_PATH="ghc-@ProjectVersion@"
diff --git a/driver/ghci/ghci.c b/driver/ghci/ghci.c
index a603655ec8..652770e39e 100644
--- a/driver/ghci/ghci.c
+++ b/driver/ghci/ghci.c
@@ -33,7 +33,7 @@ int main(int argc, char** argv) {
     }
 
     binDir = getExecutablePath();
-    exePath = mkString("%s/ghc.exe", binDir);
+    exePath = mkString("%s/%s.exe", binDir, EXE_PATH);
     preArgv[0] = "--interactive";
 
     /* If ghc.exe can't be found, we assume that we're building ghc from
diff --git a/hadrian/bindist/cwrappers/version-wrapper.c b/hadrian/bindist/cwrappers/version-wrapper.c
index f91c4c7f83..335be4e9d0 100644
--- a/hadrian/bindist/cwrappers/version-wrapper.c
+++ b/hadrian/bindist/cwrappers/version-wrapper.c
@@ -2,6 +2,17 @@
 #include "cwrapper.h"
 #include "getLocation.h"
 #include <stddef.h>
+#include <windows.h>
+
+/* In order for this console program to pass on full event processing to called
+   process we need to remove it from the current console. Since we want the
+   child to inherit the handles so redirection etc all work we need to detach
+   from the console after the child has been created. However we don't want to
+   detach from the console in non-interactive scenarios otherwise we'll hit
+   #13411 again. So we only detach when we're sure we need to, see #14150.  */
+void ReleaseResource(void) {
+    FreeConsole();
+}
 
 int main(int argc, char** argv) {
     char *binDir;
@@ -10,5 +21,10 @@ int main(int argc, char** argv) {
     binDir = getExecutablePath();
     exePath = mkString("%s/%s", binDir, EXE_PATH);
 
-    run(exePath, 0, NULL, argc - 1, argv + 1, NULL);
+    run(exePath, 0, NULL, argc - 1, argv + 1,
+#if INTERACTIVE_PROCESS
+            ReleaseResource);
+#else
+            NULL);
+#endif
 }
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)
 
 {-