In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/afa4768ac90fcd6a53a3661885a238d344a02f92?hp=3626fc2020b81652c4b3c7dd5ef0822b194d2d5e>
- Log -----------------------------------------------------------------
commit afa4768ac90fcd6a53a3661885a238d344a02f92
Author: James E Keenan <jkee...@cpan.org>
Date: Thu Jan 12 17:15:30 2017 -0500
Write tests for RT #77934.
Assistance with test provided by Jerry Hedden.
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
dist/threads/t/kill3.t | 113 +++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 114 insertions(+)
create mode 100644 dist/threads/t/kill3.t
diff --git a/MANIFEST b/MANIFEST
index b0197df363..d31ee1a8ed 100644
--- 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
index 0000000000..15e3f1690f
--- /dev/null
+++ b/dist/threads/t/kill3.t
@@ -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);
--
Perl5 Master Repository
