@@ -1,5 +1,8 @@
Revision history for Perl extension threads.
+1.96 Wed Aug 27 22:05:34 2014
+ - Sync from blead
+
1.92 Tue Feb 4 23:35:31 2014
- Version bump for blead
@@ -4,7 +4,7 @@
"Artur Bergman, Jerry D. Hedden <jdhedden AT cpan DOT org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.88, CPAN::Meta::Converter version 2.133380",
+ "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
"license" : [
"perl_5"
],
@@ -46,5 +46,5 @@
}
},
"release_status" : "stable",
- "version" : "1.92"
+ "version" : "1.96"
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.88, CPAN::Meta::Converter version 2.133380'
+generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -28,4 +28,4 @@ requires:
overload: 0
strict: 0
warnings: 0
-version: 1.92
+version: 1.96
@@ -1,4 +1,4 @@
-threads version 1.92
+threads version 1.96
====================
This module exposes interpreter threads to the Perl level.
@@ -5,7 +5,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '1.92';
+our $VERSION = '1.96';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -134,7 +134,17 @@ threads - Perl interpreter-based threads
=head1 VERSION
-This document describes threads version 1.92
+This document describes threads version 1.96
+
+=head1 WARNING
+
+The "interpreter-based threads" provided by Perl are not the fast, lightweight
+system for multitasking that one might expect or hope for. Threads are
+implemented in a way that make them easy to misuse. Few people know how to
+use them correctly or will be able to provide help.
+
+The use of interpreter-based threads in perl is officially
+L<discouraged|perlpolicy/discouraged>.
=head1 SYNOPSIS
@@ -996,7 +1006,8 @@ signalling behavior is only in effect in the following situations:
=item * Perl has been built with C<PERL_OLD_SIGNALS> (see C<perl -V>).
-=item * The environment variable C<PERL_SIGNALS> is set to C<unsafe> (see L<perlrun/"PERL_SIGNALS">).
+=item * The environment variable C<PERL_SIGNALS> is set to C<unsafe>
+(see L<perlrun/"PERL_SIGNALS">).
=item * The module L<Perl::Unsafe::Signals> is used.
@@ -28,7 +28,7 @@ my $result = $thr->join();
ok(! defined($result), 'thread died');
# Check error
-like($thr->error(), q/Can't locate object method/, 'thread error');
+like($thr->error(), qr/^Can't locate object method/s, 'thread error');
# Create a thread that 'die's with an object
@@ -48,7 +48,7 @@ my $rc = $thr->join();
ok(! defined($rc), 'Exited: threads->exit()');
-run_perl(prog => 'use threads 1.92;' .
+run_perl(prog => 'use threads 1.96;' .
'threads->exit(86);' .
'exit(99);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -98,7 +98,7 @@ $rc = $thr->join();
ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
-run_perl(prog => 'use threads 1.92 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.96 qw(exit thread_only);' .
'threads->create(sub { exit(99); })->join();' .
'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -108,7 +108,7 @@ run_perl(prog => 'use threads 1.92 qw(exit thread_only);' .
is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
}
-my $out = run_perl(prog => 'use threads 1.92;' .
+my $out = run_perl(prog => 'use threads 1.96;' .
'threads->create(sub {' .
' exit(99);' .
'});' .
@@ -121,10 +121,10 @@ my $out = run_perl(prog => 'use threads 1.92;' .
local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
is($?>>8, 99, "exit(status) in thread");
}
-like($out, '1 finished and unjoined', "exit(status) in thread");
+like($out, qr/1 finished and unjoined/, "exit(status) in thread");
-$out = run_perl(prog => 'use threads 1.92 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.96 qw(exit thread_only);' .
'threads->create(sub {' .
' threads->set_thread_exit_only(0);' .
' exit(99);' .
@@ -138,10 +138,10 @@ $out = run_perl(prog => 'use threads 1.92 qw(exit thread_only);' .
local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
is($?>>8, 99, "set_thread_exit_only(0)");
}
-like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
+like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)");
-run_perl(prog => 'use threads 1.92;' .
+run_perl(prog => 'use threads 1.96;' .
'threads->create(sub {' .
' $SIG{__WARN__} = sub { exit(99); };' .
' die();' .
@@ -53,6 +53,7 @@ sub plan {
}
} else {
my %plan = @_;
+ $plan{skip_all} and skip_all($plan{skip_all});
$n = $plan{tests};
}
_print "1..$n\n" unless $noplan;
@@ -420,6 +421,14 @@ sub unlike ($$@) { like_yn (1,@_) }; # 1 for un-
sub like_yn ($$$@) {
my ($flip, undef, $expected, $name, @mess) = @_;
+
+ # We just accept like(..., qr/.../), not like(..., '...'), and
+ # definitely not like(..., '/.../') like
+ # Test::Builder::maybe_regex() does.
+ unless (re::is_regexp($expected)) {
+ die "PANIC: The value '$expected' isn't a regexp. The like() function needs a qr// pattern, not a string";
+ }
+
my $pass;
$pass = $_[1] =~ /$expected/ if !$flip;
$pass = $_[1] !~ /$expected/ if $flip;
@@ -564,7 +573,8 @@ USE_OK
# progs => [ multi-liner (avoid quotes) ]
# progfile => perl script
# stdin => string to feed the stdin (or undef to redirect from /dev/null)
-# stderr => redirect stderr to stdout
+# stderr => If 'devnull' suppresses stderr, if other TRUE value redirect
+# stderr to stdout
# args => [ command-line arguments to the perl program ]
# verbose => print the command line
@@ -680,7 +690,12 @@ sub _create_runperl { # Create the string to qx in runperl().
if (defined $args{args}) {
$runperl = _quote_args($runperl, $args{args});
}
- $runperl = $runperl . ' 2>&1' if $args{stderr};
+ if (exists $args{stderr} && $args{stderr} eq 'devnull') {
+ $runperl = $runperl . ($is_mswin ? ' 2>nul' : ' 2>/dev/null');
+ }
+ elsif ($args{stderr}) {
+ $runperl = $runperl . ' 2>&1';
+ }
if ($args{verbose}) {
my $runperldisplay = $runperl;
$runperldisplay =~ s/\n/\n\#/g;
@@ -869,6 +884,28 @@ sub tempfile {
die "Can't find temporary file name starting \"tmp$$\"";
}
+# register_tempfile - Adds a list of files to be removed at the end of the current test file
+# Arguments :
+# a list of files to be removed later
+
+# returns a count of how many file names were actually added
+
+# Reuses %tmpfiles so that tempfile() will also skip any files added here
+# even if the file doesn't exist yet.
+
+sub register_tempfile {
+ my $count = 0;
+ for( @_ ){
+ if( $tmpfiles{$_} ){
+ _print_stderr "# Temporary file '$_' already added\n";
+ }else{
+ $tmpfiles{$_} = 1;
+ $count = $count + 1;
+ }
+ }
+ return $count;
+}
+
# This is the temporary file for _fresh_perl
my $tmpfile = tempfile();
@@ -1530,8 +1567,14 @@ sub watchdog ($;$)
# Add END block to parent to terminate and
# clean up watchdog process
- eval "END { local \$! = 0; local \$? = 0;
- wait() if kill('KILL', $watchdog); };";
+ # Win32 watchdog is launched by cmd.exe shell, so use process group
+ # kill, otherwise the watchdog is never killed and harness waits
+ # every time for the timeout, #121395
+ eval( $is_mswin ?
+ "END { local \$! = 0; local \$? = 0;
+ wait() if kill('-KILL', $watchdog); };"
+ : "END { local \$! = 0; local \$? = 0;
+ wait() if kill('KILL', $watchdog); };");
return;
}
@@ -1618,57 +1661,4 @@ WATCHDOG_VIA_ALARM:
}
}
-# The following 2 functions allow tests to work on both EBCDIC and
-# ASCII-ish platforms. They convert string scalars between the native
-# character set and the set of 256 characters which is usually called
-# Latin1.
-
-sub native_to_latin1($) {
- my $string = shift;
-
- return $string if ord('^') == 94; # ASCII, Latin1
- my $output = "";
- for my $i (0 .. length($string) - 1) {
- $output .= chr(ord_native_to_latin1(ord(substr($string, $i, 1))));
- }
- # Preserve utf8ness of input onto the output, even if it didn't need to be
- # utf8
- utf8::upgrade($output) if utf8::is_utf8($string);
-
- return $output;
-}
-
-sub latin1_to_native($) {
- my $string = shift;
-
- return $string if ord('^') == 94; # ASCII, Latin1
- my $output = "";
- for my $i (0 .. length($string) - 1) {
- $output .= chr(ord_latin1_to_native(ord(substr($string, $i, 1))));
- }
- # Preserve utf8ness of input onto the output, even if it didn't need to be
- # utf8
- utf8::upgrade($output) if utf8::is_utf8($string);
-
- return $output;
-}
-
-sub ord_latin1_to_native {
- # given an input code point, return the platform's native
- # equivalent value. Anything above latin1 is itself.
-
- my $ord = shift;
- return $ord if ord('^') == 94; # ASCII, Latin1
- return utf8::unicode_to_native($ord);
-}
-
-sub ord_native_to_latin1 {
- # given an input platform code point, return the latin1 equivalent value.
- # Anything above latin1 is itself.
-
- my $ord = shift;
- return $ord if ord('^') == 94; # ASCII, Latin1
- return utf8::native_to_unicode($ord);
-}
-
1;
@@ -161,7 +161,7 @@ package main;
# bugid #24165
-run_perl(prog => 'use threads 1.92;' .
+run_perl(prog => 'use threads 1.96;' .
'sub a{threads->create(shift)} $t = a sub{};' .
'$t->tid; $t->join; $t->tid',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -346,7 +346,7 @@ S_exit_warning(pTHX)
/* Called from perl_destruct() in each thread. If it's the main thread,
* stop it from freeing everything if there are other threads still running.
*/
-int
+STATIC int
Perl_ithread_hook(pTHX)
{
dMY_POOL;
@@ -356,7 +356,7 @@ Perl_ithread_hook(pTHX)
/* MAGIC (in mg.h sense) hooks */
-int
+STATIC int
ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *)mg->mg_ptr;
@@ -365,7 +365,7 @@ ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
-int
+STATIC int
ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *)mg->mg_ptr;
@@ -375,7 +375,7 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
-int
+STATIC int
ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
{
PERL_UNUSED_ARG(param);
@@ -383,7 +383,7 @@ ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
return (0);
}
-MGVTBL ithread_vtbl = {
+STATIC const MGVTBL ithread_vtbl = {
ithread_mg_get, /* get */
0, /* set */
0, /* len */
@@ -713,11 +713,14 @@ S_ithread_create(
}
PERL_SET_CONTEXT(aTHX);
if (!thread) {
- int rc;
MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
- rc = PerlLIO_write(PerlIO_fileno(Perl_error_log),
- PL_no_mem, strlen(PL_no_mem));
- PERL_UNUSED_VAR(rc);
+ {
+ int fd = PerlIO_fileno(Perl_error_log);
+ if (fd >= 0) {
+ /* If there's no error_log, we cannot scream about it missing. */
+ PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem));
+ }
+ }
my_exit(1);
}
Zero(thread, 1, ithread);