On Windows normalize $^X using GetLongPathName()

If perl.exe is called with a short pathname, then GetModuleFileName()
will return this short name, and $^X will be set to it.  This in turn
is used to initialize @INC to privlib, sitelib and vendorlib locations
relative to $^X, so they too will end up with the mangled short names.

Perl will also automatically add versioned Perl directories in the
same tree if their names start with the same major and minor Perl
version numbers.  This heuristic can be broken when the pathname
components are using short pathnames.  Therefore $^X and @INC should
all be normalized to use the long pathname format.

See also http://rt.cpan.org/Public/Bug/Display.html?id=47890

(cherry picked from commit ad2561310d3fa13cf664e8d8b8bb294a23cf9ea4)

1 files changed, 12 insertions, 0 deletions

diff --git a/win32/win32.c b/win32/win32.c
index 9cc5361309..748e113275 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -225,12 +225,24 @@ set_w32_module_name(void)
         WCHAR fullname[MAX_PATH];
         char *ansi;
 
+        DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
+            (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
+            GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
+
         GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
 
         /* Make sure we get an absolute pathname in case the module was loaded
          * explicitly by LoadLibrary() with a relative path. */
         GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
 
+        /* Make sure we start with the long path name of the module because we
+         * later scan for pathname components to match "5.xx" to locate
+         * compatible sitelib directories, and the short pathname might mangle
+         * this path segment (e.g. by removing the dot on NTFS to something
+         * like "5xx~1.yy") */
+        if (pfnGetLongPathNameW)
+            pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
+
         /* remove \\?\ prefix */
         if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
             memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));