Skip to content

Commit

Permalink
Merge pull request #10 from Dual-Life/develop
Browse files Browse the repository at this point in the history
2.21 Clang macros and docs
  • Loading branch information
jdhedden authored Jan 23, 2018
2 parents 972c1b6 + df0be65 commit cdd5d7d
Show file tree
Hide file tree
Showing 9 changed files with 155 additions and 44 deletions.
5 changes: 5 additions & 0 deletions Changes
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,11 @@ Revision history for Perl extension threads.
-
-

2.21 Mon Jan 22 20:09:07 EST 2018
- Fix to CLANG macros
- Can return subs from threads. See docs.
- Sync from blead

2.16 Sun May 7 22:32:59 2017
- Fix Clang macro backward compatibility per patch by Andy Grundman
- Sync from blead
Expand Down
2 changes: 1 addition & 1 deletion README
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
threads version 2.16
threads version 2.21
====================

This module exposes interpreter threads to the Perl level.
Expand Down
36 changes: 20 additions & 16 deletions lib/threads.pm
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ use 5.008;
use strict;
use warnings;

our $VERSION = '2.16';
our $VERSION = '2.21'; # remember to update version in POD!
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;

Expand Down Expand Up @@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
=head1 VERSION
This document describes threads version 2.16
This document describes threads version 2.21
=head1 WARNING
Expand Down Expand Up @@ -987,13 +987,6 @@ L</"THREAD SIGNALLING"> to relay the signal to the thread:
On some platforms, it might not be possible to destroy I<parent> threads while
there are still existing I<child> threads.
=item Creating threads inside special blocks
Creating threads inside C<BEGIN>, C<CHECK> or C<INIT> blocks should not be
relied upon. Depending on the Perl version and the application code, results
may range from success, to (apparently harmless) warnings of leaked scalar, or
all the way up to crashing of the Perl interpreter.
=item Unsafe signals
Since Perl 5.8.0, signals have been made safer in Perl by postponing their
Expand All @@ -1018,16 +1011,27 @@ signalling behavior is only in effect in the following situations:
If unsafe signals is in effect, then signal handling is not thread-safe, and
the C<-E<gt>kill()> signalling method cannot be used.
=item Returning closures from threads
=item Identity of objects returned from threads
When a value is returned from a thread through a C<join> operation,
the value and everything that it references is copied across to the
joining thread, in much the same way that values are copied upon thread
creation. This works fine for most kinds of value, including arrays,
hashes, and subroutines. The copying recurses through array elements,
reference scalars, variables closed over by subroutines, and other kinds
of reference.
Returning closures from threads should not be relied upon. Depending on the
Perl version and the application code, results may range from success, to
(apparently harmless) warnings of leaked scalar, or all the way up to crashing
of the Perl interpreter.
However, everything referenced by the returned value is a fresh copy in
the joining thread, even if a returned object had in the child thread
been a copy of something that previously existed in the parent thread.
After joining, the parent will therefore have a duplicate of each such
object. This sometimes matters, especially if the object gets mutated;
this can especially matter for private data to which a returned subroutine
provides access.
=item Returning objects from threads
=item Returning blessed objects from threads
Returning objects from threads does not work. Depending on the classes
Returning blessed objects from threads does not work. Depending on the classes
involved, you may be able to work around this by returning a serialized
version of the object (e.g., using L<Data::Dumper> or L<Storable>), and then
reconstituting it in the joining thread. If you're using Perl 5.10.0 or
Expand Down
10 changes: 5 additions & 5 deletions t/exit.t
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ my $rc = $thr->join();
ok(! defined($rc), 'Exited: threads->exit()');


run_perl(prog => 'use threads 2.16;' .
run_perl(prog => 'use threads 2.21;' .
'threads->exit(86);' .
'exit(99);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
Expand Down Expand Up @@ -98,7 +98,7 @@ $rc = $thr->join();
ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');


run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
run_perl(prog => 'use threads 2.21 qw(exit thread_only);' .
'threads->create(sub { exit(99); })->join();' .
'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
Expand All @@ -108,7 +108,7 @@ run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
}

my $out = run_perl(prog => 'use threads 2.16;' .
my $out = run_perl(prog => 'use threads 2.21;' .
'threads->create(sub {' .
' exit(99);' .
'});' .
Expand All @@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 2.16;' .
like($out, qr/1 finished and unjoined/, "exit(status) in thread");


$out = run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
$out = run_perl(prog => 'use threads 2.21 qw(exit thread_only);' .
'threads->create(sub {' .
' threads->set_thread_exit_only(0);' .
' exit(99);' .
Expand All @@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)");


run_perl(prog => 'use threads 2.16;' .
run_perl(prog => 'use threads 2.21;' .
'threads->create(sub {' .
' $SIG{__WARN__} = sub { exit(99); };' .
' die();' .
Expand Down
10 changes: 6 additions & 4 deletions t/kill3.t
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,9 @@ BEGIN {

{
$SIG{'KILL'} = undef;
chdir '/tmp';
my $dir = File::Spec->catdir( '/tmp', "toberead$$" );
my $tmp = File::Spec->tmpdir();
chdir $tmp;
my $dir = File::Spec->catdir( $tmp, "toberead$$" );
mkdir $dir;
chdir $dir;
for ('a'..'e') {
Expand Down Expand Up @@ -77,8 +78,9 @@ EOI

{
$SIG{'KILL'} = undef;
chdir '/tmp';
my $dir = File::Spec->catdir( '/tmp', "shouldberead$$" );
my $tmp = File::Spec->tmpdir();
chdir $tmp;
my $dir = File::Spec->catdir( $tmp, "shouldberead$$" );
mkdir $dir;
chdir $dir;
for ('a'..'e') {
Expand Down
10 changes: 7 additions & 3 deletions t/test.pl
Original file line number Diff line number Diff line change
Expand Up @@ -212,6 +212,9 @@ sub find_git_or_skip {
} else {
$reason = 'not being run from a git checkout';
}
if ($ENV{'PERL_BUILD_PACKAGING'}) {
$reason = 'PERL_BUILD_PACKAGING is set';
}
skip_all($reason) if $_[0] && $_[0] eq 'all';
skip($reason, @_);
}
Expand Down Expand Up @@ -860,7 +863,7 @@ sub unlink_all {
if( -f $file ){
_print_stderr "# Couldn't unlink '$file': $!\n";
}else{
++$count;
$count = $count + 1; # don't use ++
}
}
$count;
Expand Down Expand Up @@ -914,7 +917,7 @@ sub _num_to_alpha{
my $tempfile_count = 0;
sub tempfile {
while(1){
my $try = "tmp$$";
my $try = (-d "t" ? "t/" : "")."tmp$$";
my $alpha = _num_to_alpha($tempfile_count,2);
last unless defined $alpha;
$try = $try . $alpha;
Expand Down Expand Up @@ -1141,7 +1144,7 @@ sub setup_multiple_progs {
my $found;
while (<$fh>) {
if (/^__END__/) {
++$found;
$found = $found + 1; # don't use ++
last;
}
}
Expand Down Expand Up @@ -1516,6 +1519,7 @@ sub capture_warnings {

local @::__capture;
local $SIG {__WARN__} = \&__capture;
local $Level = 1;
&$code;
return @::__capture;
}
Expand Down
2 changes: 1 addition & 1 deletion t/thread.t
Original file line number Diff line number Diff line change
Expand Up @@ -161,7 +161,7 @@ package main;

# bugid #24165

run_perl(prog => 'use threads 2.16;' .
run_perl(prog => 'use threads 2.21;' .
'sub a{threads->create(shift)} $t = a sub{};' .
'$t->tid; $t->join; $t->tid',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
Expand Down
81 changes: 81 additions & 0 deletions t/unique.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,81 @@
use strict;
use warnings;

BEGIN {
use Config;
if (! $Config{'useithreads'}) {
print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
exit(0);
}
if ($] >= 5.027000) {
print("1..0 # SKIP 'unique' attribute no longer exists\n");
exit(0);
}
}

use ExtUtils::testlib;

use threads;

BEGIN {
if (! eval 'use threads::shared; 1') {
print("1..0 # SKIP threads::shared not available\n");
exit(0);
}

$| = 1;
print("1..6\n") ; ### Number of tests that will be run ###
}

print("ok 1 - Loaded\n");

### Start of Testing ###

no warnings 'deprecated'; # Suppress warnings related to :unique

my $test :shared = 2;

# bugid 24383 - :unique hashes weren't being made readonly on interpreter
# clone; check that they are.

our $unique_scalar : unique;
our @unique_array : unique;
our %unique_hash : unique;
threads->create(sub {
lock($test);
my $TODO = ":unique needs to be re-implemented in a non-broken way";
eval { $unique_scalar = 1 };
print $@ =~ /read-only/
? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n";
$test++;
eval { $unique_array[0] = 1 };
print $@ =~ /read-only/
? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
$test++;
if ($] >= 5.008003 && $^O ne 'MSWin32') {
eval { $unique_hash{abc} = 1 };
print $@ =~ /disallowed/
? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n";
} else {
print("ok $test # SKIP $TODO - unique_hash\n");
}
$test++;
})->join;

# bugid #24940 :unique should fail on my and sub declarations

for my $decl ('my $x : unique', 'sub foo : unique') {
{
lock($test);
if ($] >= 5.008005) {
eval $decl;
print $@ =~ /^The 'unique' attribute may only be applied to 'our' variables/
? '' : 'not ', "ok $test - $decl\n";
} else {
print("ok $test # SKIP $decl\n");
}
$test++;
}
}


43 changes: 29 additions & 14 deletions threads.xs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,17 @@
# endif
#endif

#ifndef CLANG_DIAG_IGNORE
# define CLANG_DIAG_IGNORE(x)
# define CLANG_DIAG_RESTORE
#endif
#ifndef CLANG_DIAG_IGNORE_STMT
# define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP
# define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP
# define CLANG_DIAG_IGNORE_DECL(x) CLANG_DIAG_IGNORE(x) dNOOP
# define CLANG_DIAG_RESTORE_DECL CLANG_DIAG_RESTORE dNOOP
#endif

#ifdef USE_ITHREADS

#ifdef __amigaos4__
Expand Down Expand Up @@ -870,15 +881,18 @@ S_ithread_create(
reallocated (and hence move) as a side effect of calls to
perl_clone() and sv_dup_inc(). Hence copy the parameters
somewhere under our control first, before duplicating. */
if (num_params) {
#if (PERL_VERSION > 8)
Copy(parent_perl->Istack_base + params_start, array, num_params, SV *);
Copy(parent_perl->Istack_base + params_start, array, num_params, SV *);
#else
Copy(parent_perl->Tstack_base + params_start, array, num_params, SV *);
Copy(parent_perl->Tstack_base + params_start, array, num_params, SV *);
#endif
while (num_params--) {
*array = sv_dup_inc(*array, clone_param);
++array;
while (num_params--) {
*array = sv_dup_inc(*array, clone_param);
++array;
}
}

#if (PERL_VERSION > 13) || (PERL_VERSION == 13 && PERL_SUBVERSION > 1)
Perl_clone_params_del(clone_param);
#endif
Expand Down Expand Up @@ -1016,15 +1030,10 @@ S_ithread_create(
MUTEX_UNLOCK(&my_pool->create_destruct_mutex);
return (thread);

#if defined(CLANG_DIAG_IGNORE)
CLANG_DIAG_IGNORE(-Wthread-safety);
CLANG_DIAG_IGNORE_STMT(-Wthread-safety);
/* warning: mutex 'thread->mutex' is not held on every path through here [-Wthread-safety-analysis] */
#endif
}
/* perl.h defines CLANG_DIAG_* but only in 5.24+ */
#if defined(CLANG_DIAG_RESTORE)
CLANG_DIAG_RESTORE
#endif
CLANG_DIAG_RESTORE_DECL;

#endif /* USE_ITHREADS */

Expand Down Expand Up @@ -1162,10 +1171,10 @@ ithread_create(...)

/* Let thread run. */
/* See S_ithread_run() for more detail. */
CLANG_DIAG_IGNORE(-Wthread-safety);
CLANG_DIAG_IGNORE_STMT(-Wthread-safety);
/* warning: releasing mutex 'thread->mutex' that was not held [-Wthread-safety-analysis] */
MUTEX_UNLOCK(&thread->mutex);
CLANG_DIAG_RESTORE;
CLANG_DIAG_RESTORE_STMT;

/* XSRETURN(1); - implied */

Expand Down Expand Up @@ -1360,6 +1369,9 @@ ithread_join(...)
ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
# ifdef PL_sv_zero
ptr_table_store(PL_ptr_table, &other_perl->Isv_zero, &PL_sv_zero);
# endif
params = (AV *)sv_dup((SV*)params_copy, clone_params);
S_ithread_set(aTHX_ current_thread);
Perl_clone_params_del(clone_params);
Expand Down Expand Up @@ -1788,6 +1800,9 @@ ithread_error(...)
ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
# ifdef PL_sv_zero
ptr_table_store(PL_ptr_table, &other_perl->Isv_zero, &PL_sv_zero);
# endif
err = sv_dup(thread->err, clone_params);
S_ithread_set(aTHX_ current_thread);
Perl_clone_params_del(clone_params);
Expand Down

0 comments on commit cdd5d7d

Please sign in to comment.