4 files changed, 62 insertions, 1 deletions
diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 63ea85831a..ec8bc9e3de 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '0.60_01';
+our $VERSION = '0.60_02';
 
 require XSLoader;
 
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 8e78736af7..79c2264c8c 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -4792,3 +4792,13 @@ test_toTITLE_utf8(SV * p)
         RETVAL = av;
     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 --git a/ext/XS-APItest/t/win32.t b/ext/XS-APItest/t/win32.t
new file mode 100644
index 0000000000..a8905c2549
--- /dev/null
+++ b/ext/XS-APItest/t/win32.t
@@ -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 --git a/ext/XS-APItest/typemap b/ext/XS-APItest/typemap
index 035f882a6b..ed86a374f1 100644
--- a/ext/XS-APItest/typemap
+++ b/ext/XS-APItest/typemap
@@ -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)));