Write tests for RT #77934.
authorJames E Keenan <jkeenan@cpan.org>
Thu, 12 Jan 2017 22:15:30 +0000 (17:15 -0500)
committerJames E Keenan <jkeenan@cpan.org>
Fri, 13 Jan 2017 00:39:16 +0000 (19:39 -0500)
Assistance with test provided by Jerry Hedden.

MANIFEST
dist/threads/t/kill3.t [new file with mode: 0644]

index b0197df..d31ee1a 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3689,6 +3689,7 @@ dist/threads/t/free2.t            More ithread destruction tests
 dist/threads/t/join.t          Testing the join function
 dist/threads/t/kill.t          Tests thread signalling
 dist/threads/t/kill2.t         Tests thread signalling
+dist/threads/t/kill3.t         Tests thread signalling
 dist/threads/t/libc.t          testing libc functions for threadsafety
 dist/threads/t/list.t          Test threads->list()
 dist/threads/t/no_threads.t    threads test for non-threaded Perls
diff --git a/dist/threads/t/kill3.t b/dist/threads/t/kill3.t
new file mode 100644 (file)
index 0000000..15e3f16
--- /dev/null
@@ -0,0 +1,113 @@
+use strict;
+use warnings;
+
+BEGIN {
+    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
+
+    use Config;
+    if (! $Config{'useithreads'}) {
+        skip_all(q/Perl not compiled with 'useithreads'/);
+    }
+}
+
+use ExtUtils::testlib;
+use Cwd;
+my $cwd = cwd();
+
+use threads;
+
+BEGIN {
+    if (! eval 'use threads::shared; 1') {
+        skip_all('threads::shared not available');
+    }
+
+    local $SIG{'HUP'} = sub {};
+    my $thr = threads->create(sub {});
+    eval { $thr->kill('HUP') };
+    $thr->join();
+    if ($@ && $@ =~ /safe signals/) {
+        skip_all('Not using safe signals');
+    }
+
+    plan(2);
+};
+
+{
+    $SIG{'KILL'} = undef;
+    chdir '/tmp';
+    mkdir "toberead$$";
+    chdir "toberead$$";
+    for ('a'..'e') {
+        open my $THING, ">$_";
+        close $THING or die "$_: $!";
+    }
+    chdir $cwd;
+
+    local $ARGV[0] = undef;
+    fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-false $ARGV[0]');
+    local $@;
+    my $DIRH;
+    my $thr;
+    $thr = async {
+        # Thread 'cancellation' signal handler
+        $SIG{'KILL'} = sub { threads->exit(); };
+
+        opendir $DIRH, ".";
+        my $start = telldir $DIRH;
+        while (1) {
+            readdir $DIRH or seekdir $DIRH, 0;
+        }
+    } if $ARGV[0];
+
+    opendir $DIRH, ".";
+    for(1..5) {
+        select undef, undef, undef, .25;
+    }
+
+    if ($ARGV[0]) {
+        $thr->kill('KILL')->detach();
+    }
+    print($@ ? 'not ok' : 'ok');
+EOI
+}
+
+{
+    $SIG{'KILL'} = undef;
+    chdir '/tmp';
+    mkdir "shouldberead$$";
+    chdir "shouldberead$$";
+    for ('a'..'e') {
+        open my $THING, ">$_";
+        close $THING or die "$_: $!";
+    }
+    chdir $cwd;
+
+    local $ARGV[0] = 1;
+    fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-true  $ARGV[0]');
+    local $@;
+    my $DIRH;
+    my $thr;
+    $thr = async {
+        # Thread 'cancellation' signal handler
+        $SIG{'KILL'} = sub { threads->exit(); };
+
+        opendir $DIRH, ".";
+        my $start = telldir $DIRH;
+        while (1) {
+            readdir $DIRH or seekdir $DIRH, 0;
+        }
+    } if $ARGV[0];
+
+    opendir $DIRH, ".";
+    for(1..5) {
+        select undef, undef, undef, .25;
+    }
+
+    if ($ARGV[0]) {
+        $thr->kill('KILL')->detach();
+    }
+    print($@ ? 'not ok' : 'ok');
+EOI
+}
+
+exit(0);