Initialize hs_init with UTF8 encoded arguments on Windows.

Summary:
Get utf8 encoded arguments before we call hs_init and use them
instead of ignoring hs_init arguments. This reduces differing
behaviour of the RTS between windows and linux and simplifies
the code involved.

A few testcases were changed to expect the same result on windows
as on linux after the changes.

This fixes #13940.

Test Plan: ./validate

Reviewers: austin, hvr, bgamari, erikd, simonmar, Phyx

Subscribers: Phyx, rwbarton, thomie

GHC Trac Issues: #13940

Differential Revision: https://phabricator.haskell.org/D3739

1 files changed, 26 insertions, 0 deletions

diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 71a842d0a9..e4ca6b906d 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -179,7 +179,33 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     if (argc == NULL || argv == NULL) {
         // Use a default for argc & argv if either is not supplied
         int my_argc = 1;
+        #if defined(mingw32_HOST_OS)
+        //Retry larger buffer sizes on error up to about the NTFS length limit.
+        wchar_t* pathBuf;
+        char *my_argv[2] = { NULL, NULL };
+        for(DWORD maxLength = MAX_PATH; maxLength <= 33280; maxLength *= 2)
+        {
+            pathBuf = (wchar_t*) stgMallocBytes(sizeof(wchar_t) * maxLength,
+                "hs_init_ghc: GetModuleFileName");
+            DWORD pathLength = GetModuleFileNameW(NULL, pathBuf, maxLength);
+            if(GetLastError() == ERROR_INSUFFICIENT_BUFFER || pathLength == 0) {
+                stgFree(pathBuf);
+                pathBuf = NULL;
+            } else {
+                break;
+            }
+        }
+        if(pathBuf == NULL) {
+            my_argv[0] = "<unknown>";
+        } else {
+            my_argv[0] = lpcwstrToUTF8(pathBuf);
+            stgFree(pathBuf);
+        }
+
+
+        #else
         char *my_argv[] = { "<unknown>", NULL };
+        #endif
         setFullProgArgv(my_argc,my_argv);
         setupRtsFlags(&my_argc, my_argv, rts_config);
     } else {