This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #122476] TODO test for isfoo() crash on Win32 with threads
authorTony Cook <tony@develop-help.com>
Mon, 11 Aug 2014 06:31:32 +0000 (16:31 +1000)
committerTony Cook <tony@develop-help.com>
Fri, 15 Aug 2014 01:17:57 +0000 (11:17 +1000)
MANIFEST
ext/POSIX/t/is.t
ext/POSIX/t/iscrash [new file with mode: 0644]

index 179cc3d..8479f03 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3680,6 +3680,7 @@ ext/POSIX/lib/POSIX.pod           POSIX extension documentation
 ext/POSIX/Makefile.PL          POSIX extension makefile writer
 ext/POSIX/POSIX.xs             POSIX extension external subroutines
 ext/POSIX/t/export.t           Test @EXPORT and @EXPORT_OK
+ext/POSIX/t/iscrash            See if POSIX isxxx() crashes with threads on Win32
 ext/POSIX/t/is.t               See if POSIX isxxx() work
 ext/POSIX/t/math.t             Basic math tests for POSIX
 ext/POSIX/t/posix.t            See if POSIX works
index 0ab328e..911a256 100644 (file)
@@ -71,7 +71,7 @@ foreach my $s (keys %classes) {
 
 # Expected number of tests is one each for every combination of a
 # known is<xxx> function and string listed above.
-plan(tests => keys(%classes) * keys(%functions) + 1);
+plan(tests => keys(%classes) * keys(%functions) + 2);
 
 # Main test loop: Run all POSIX::is<xxx> tests on each string defined above.
 # Only the character classes listed for that string should return 1.  We
@@ -119,3 +119,21 @@ foreach my $s (sort keys %classes) {
     # calls
     is(scalar @warnings, 20);
 }
+
+SKIP:
+{
+    # [perl #122476] - is*() could crash when threads were involved on Win32
+    # this only crashed on Win32, only test there
+    # When the is*() functions are removed, also remove "iscrash"
+    skip("Not Win32", 1) unless $^O eq "MSWin32";
+    skip("No threads", 1) unless $Config{useithreads};
+    skip("No Win32API::File", 1)
+      unless $Config{extensions} =~ m(\bWin32API/File\b);
+
+    local $TODO = "this code crashes perl";
+    local $ENV{PERL5LIB} =
+      join($Config{path_sep},
+          map / / ? qq("$_") : $_, @INC);
+    my $result = `$^X t/iscrash`;
+    like($result, qr/\bok\b/, "is in threads didn't crash");
+}
diff --git a/ext/POSIX/t/iscrash b/ext/POSIX/t/iscrash
new file mode 100644 (file)
index 0000000..94d04cb
--- /dev/null
@@ -0,0 +1,20 @@
+# test file for checking that the  is*() functions don't crash
+use Win32API::File qw(SetErrorMode SEM_NOGPFAULTERRORBOX SEM_NOOPENFILEERRORBOX);
+use strict;
+use threads;
+use POSIX qw(isalpha islower);
+
+SetErrorMode(SEM_NOGPFAULTERRORBOX | SEM_NOOPENFILEERRORBOX);
+
+use warnings; # we want the warnings code to run
+$SIG{__WARN__} = sub {}; # but don't want to display them
+
+my $t1 = threads->create(sub { isalpha("c") });
+$t1->join;
+
+islower("a");
+
+my $t2 = threads->create(sub { isalpha("a") });
+$t2->join;
+
+print "ok\n";