The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
diff -ru perl-5.22.1/ext/XS-APItest/APItest.xs perl-5.22.1-patched/ext/XS-APItest/APItest.xs
--- perl-5.22.1/ext/XS-APItest/APItest.xs	2015-10-17 14:38:37.000000000 +0200
+++ perl-5.22.1-patched/ext/XS-APItest/APItest.xs	2015-12-25 17:33:22.522877400 +0100
@@ -5067,3 +5067,12 @@
     OUTPUT:
         RETVAL
 
+#if defined(WIN32) && defined(PERL_IMPLICIT_SYS)
+
+const char *
+PerlDir_mapA(const char *path)
+
+const WCHAR *
+PerlDir_mapW(const WCHAR *wpath)
+
+#endif
diff -ru perl-5.22.1/ext/XS-APItest/t/win32.t perl-5.22.1-patched/ext/XS-APItest/t/win32.t
--- perl-5.22.1/ext/XS-APItest/t/win32.t	2015-12-25 17:31:18.021201900 +0100
+++ perl-5.22.1-patched/ext/XS-APItest/t/win32.t	2015-12-25 17:33:22.537184000 +0100
@@ -0,0 +1,39 @@
+#!perl -w
+use strict;
+use Test::More;
+use XS::APItest;
+use Config;
+
+plan skip_all => "Tests only apply on MSWin32"
+  unless $^O eq "MSWin32";
+
+SKIP:
+{
+    # [perl #126755] previous the bad drive tests would crash
+    $Config{ccflags} =~ /(?:\A|\s)-DPERL_IMPLICIT_SYS\b/
+      or skip "need implicit_sys for this test", 1;
+    eval "use Encode; 1"
+      or skip "Can't load Encode", 1;
+    for my $letter ("A" .. "Z", "a" .. "z") {
+        my $good_drive = $letter . ":";
+        my $result = PerlDir_mapA($good_drive);
+        like($result, qr/^$letter:\\/i, "check good drive $letter");
+
+        my $wgood_drive = encode("UTF-16LE", $good_drive . "\0");
+        $result = PerlDir_mapW($wgood_drive);
+        like(decode("UTF16-LE", $result), qr/^$letter:\\/i,
+             "check a good drive (wide)");
+    }
+    for my $bad ('@', '[', '!', '~', '`', '{') {
+        my $bad_drive = "$bad:";
+        my $result = PerlDir_mapA($bad_drive);
+        is($result, $bad_drive, "check bad drive $bad:");
+
+        my $wbad_drive = encode("UTF-16LE", $bad_drive . "\0");
+        $result = PerlDir_mapW($wbad_drive);
+        is(decode("UTF16-LE", $result), "$bad_drive\0",
+           "check bad drive $bad: (wide)");
+    }
+}
+
+done_testing();
diff -ru perl-5.22.1/ext/XS-APItest/typemap perl-5.22.1-patched/ext/XS-APItest/typemap
--- perl-5.22.1/ext/XS-APItest/typemap	2015-10-17 14:32:14.000000000 +0200
+++ perl-5.22.1-patched/ext/XS-APItest/typemap	2015-12-25 17:33:22.537184000 +0100
@@ -1 +1,13 @@
 XS::APItest::PtrTable		T_PTROBJ
+
+const WCHAR *			WPV
+
+INPUT
+
+WPV
+        $var = ($type)SvPV_nolen($arg);
+
+OUTPUT
+
+WPV
+        sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var)));
diff -ru perl-5.22.1/MANIFEST perl-5.22.1-patched/MANIFEST
--- perl-5.22.1/MANIFEST	2015-10-31 15:40:16.000000000 +0100
+++ perl-5.22.1-patched/MANIFEST	2015-12-25 17:33:22.553772700 +0100
@@ -3965,6 +3965,7 @@
 ext/XS-APItest/t/utf8.t		Tests for code in utf8.c
 ext/XS-APItest/t/weaken.t	XS::APItest: tests for sv_rvweaken() and sv_get_backrefs()
 ext/XS-APItest/t/whichsig.t	XS::APItest: tests for whichsig() and variants
+ext/XS-APItest/t/win32.t	Test Win32 specific APIs
 ext/XS-APItest/t/xs_special_subs_require.t	for require too
 ext/XS-APItest/t/xs_special_subs.t	Test that XS BEGIN/CHECK/INIT/END work
 ext/XS-APItest/t/xsub_h.t	Tests for XSUB.h
diff -ru perl-5.22.1/win32/vdir.h perl-5.22.1-patched/win32/vdir.h
--- perl-5.22.1/win32/vdir.h	2015-10-17 14:32:30.000000000 +0200
+++ perl-5.22.1-patched/win32/vdir.h	2015-12-25 17:33:22.553772700 +0100
@@ -15,6 +15,7 @@
  * and one additional slot for a UNC name
  */
 const int driveCount = ('Z'-'A')+1+1;
+const int driveLetterCount = ('Z'-'A')+1;
 
 class VDir
 {
@@ -383,6 +384,7 @@
      * possiblities -- relative path or absolute path with or without drive letter
      * OR UNC name
      */
+    int driveIndex;
     char szBuffer[(MAX_PATH+1)*2];
     char szlBuf[MAX_PATH+1];
     int length = strlen(pInName);
@@ -402,15 +404,18 @@
     }
     /* strlen(pInName) is now <= MAX_PATH */
 
-    if (pInName[1] == ':') {
+    if (length > 1 && pInName[1] == ':') {
 	/* has drive letter */
-	if (IsPathSep(pInName[2])) {
+	if (length > 2 && IsPathSep(pInName[2])) {
 	    /* absolute with drive letter */
 	    DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
 	}
 	else {
 	    /* relative path with drive letter */
-	    strcpy(szBuffer, GetDirA(DriveIndex(*pInName)));
+            driveIndex = DriveIndex(*pInName);
+            if (driveIndex < 0 || driveIndex >= driveLetterCount)
+                return (char *)pInName;
+	    strcpy(szBuffer, GetDirA(driveIndex));
 	    strcat(szBuffer, &pInName[2]);
 	    if(strlen(szBuffer) > MAX_PATH)
 		szBuffer[MAX_PATH] = '\0';
@@ -420,7 +425,7 @@
     }
     else {
 	/* no drive letter */
-	if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+	if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
 	    /* UNC name */
 	    DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
 	}
@@ -611,6 +616,7 @@
      * possiblities -- relative path or absolute path with or without drive letter
      * OR UNC name
      */
+    int driveIndex;
     WCHAR szBuffer[(MAX_PATH+1)*2];
     WCHAR szlBuf[MAX_PATH+1];
     int length = wcslen(pInName);
@@ -630,7 +636,7 @@
     }
     /* strlen(pInName) is now <= MAX_PATH */
 
-    if (pInName[1] == ':') {
+    if (length > 1 && pInName[1] == ':') {
 	/* has drive letter */
 	if (IsPathSep(pInName[2])) {
 	    /* absolute with drive letter */
@@ -638,7 +644,10 @@
 	}
 	else {
 	    /* relative path with drive letter */
-	    wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName)));
+            driveIndex = DriveIndex(*pInName);
+            if (driveIndex < 0 || driveIndex >= driveLetterCount)
+                return (WCHAR *)pInName;
+	    wcscpy(szBuffer, GetDirW(driveIndex));
 	    wcscat(szBuffer, &pInName[2]);
 	    if(wcslen(szBuffer) > MAX_PATH)
 		szBuffer[MAX_PATH] = '\0';
@@ -648,7 +657,7 @@
     }
     else {
 	/* no drive letter */
-	if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+	if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
 	    /* UNC name */
 	    DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
 	}