Change 28604 by [EMAIL PROTECTED] on 2006/07/21 15:27:20
More tweaks to threads 1.37, by Jerry D. Hedden
Affected files ...
... //depot/perl/ext/threads/Changes#17 edit
... //depot/perl/ext/threads/t/exit.t#4 edit
... //depot/perl/ext/threads/t/thread.t#22 edit
... //depot/perl/ext/threads/threads.pm#67 edit
... //depot/perl/ext/threads/threads.xs#116 edit
Differences ...
==== //depot/perl/ext/threads/Changes#17 (xtext) ====
Index: perl/ext/threads/Changes
--- perl/ext/threads/Changes#16~28602~ 2006-07-20 14:36:25.000000000 -0700
+++ perl/ext/threads/Changes 2006-07-21 08:27:20.000000000 -0700
@@ -1,6 +1,6 @@
Revision history for Perl extension threads.
-1.37 Thu Jul 20 13:33:33 EDT 2006
+1.37 Fri Jul 21 10:51:36 EDT 2006
- Revert 'exit' behavior with override
1.36 Mon Jul 10 15:58:13 EDT 2006
==== //depot/perl/ext/threads/t/exit.t#4 (text) ====
Index: perl/ext/threads/t/exit.t
--- perl/ext/threads/t/exit.t#3~28602~ 2006-07-20 14:36:25.000000000 -0700
+++ perl/ext/threads/t/exit.t 2006-07-21 08:27:20.000000000 -0700
@@ -56,9 +56,9 @@
ok(! defined($rc), 'Exited: threads->exit()');
-run_perl(prog => 'use threads 1.37;
- threads->exit(86);
- exit(99);',
+run_perl(prog => 'use threads 1.37;' .
+ 'threads->exit(86);' .
+ 'exit(99);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
is($?>>8, 86, 'thread->exit(status) in main');
@@ -104,49 +104,45 @@
ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
-run_perl(prog => 'use threads 1.37 qw(exit thread_only);
- threads->create(sub { exit(99); })->join();
- exit(86);',
+run_perl(prog => 'use threads 1.37 qw(exit thread_only);' .
+ 'threads->create(sub { exit(99); })->join();' .
+ 'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
-SKIP: {
- skip('run_perl+STDERR broken under MSWin32', 4) if ($^O eq 'MSWin32');
-
- my $out = run_perl(prog => 'use threads 1.37;
- threads->create(sub {
- exit(99);
- })->join();
- exit(86);',
- nolib => ($ENV{PERL_CORE}) ? 0 : 1,
- switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
- stderr => 1);
- is($?>>8, 99, "exit(status) in thread");
- like($out, '1 finished and unjoined', "exit(status) in thread");
-
-
- $out = run_perl(prog => 'use threads 1.37 qw(exit thread_only);
- threads->create(sub {
- threads->set_thread_exit_only(0);
- exit(99);
- })->join();
- exit(86);',
- nolib => ($ENV{PERL_CORE}) ? 0 : 1,
- switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
- stderr => 1);
- is($?>>8, 99, "set_thread_exit_only(0)");
- like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
-}
-
-
-run_perl(prog => 'use threads 1.37;
- threads->create(sub {
- $SIG{__WARN__} = sub { exit(99); };
- die();
- })->join();
- exit(86);',
+my $out = run_perl(prog => 'use threads 1.37;' .
+ 'threads->create(sub {' .
+ ' exit(99);' .
+ '})->join();' .
+ 'exit(86);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
+ stderr => 1);
+is($?>>8, 99, "exit(status) in thread");
+like($out, '1 finished and unjoined', "exit(status) in thread");
+
+
+$out = run_perl(prog => 'use threads 1.37 qw(exit thread_only);' .
+ 'threads->create(sub {' .
+ ' threads->set_thread_exit_only(0);' .
+ ' exit(99);' .
+ '})->join();' .
+ 'exit(86);',
+ nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+ switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
+ stderr => 1);
+is($?>>8, 99, "set_thread_exit_only(0)");
+like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
+
+
+run_perl(prog => 'use threads 1.37;' .
+ 'threads->create(sub {' .
+ ' $SIG{__WARN__} = sub { exit(99); };' .
+ ' die();' .
+ '})->join();' .
+ 'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
is($?>>8, 99, "exit(status) in thread warn handler");
==== //depot/perl/ext/threads/t/thread.t#22 (text) ====
Index: perl/ext/threads/t/thread.t
--- perl/ext/threads/t/thread.t#21~28602~ 2006-07-20 14:36:25.000000000
-0700
+++ perl/ext/threads/t/thread.t 2006-07-21 08:27:20.000000000 -0700
@@ -171,9 +171,9 @@
# bugid #24165
-run_perl(prog => 'use threads 1.37;
- sub a{threads->create(shift)} $t = a sub{};
- $t->tid; $t->join; $t->tid',
+run_perl(prog => 'use threads 1.37;' .
+ 'sub a{threads->create(shift)} $t = a sub{};' .
+ '$t->tid; $t->join; $t->tid',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
is($?, 0, 'coredump in global destruction');
==== //depot/perl/ext/threads/threads.pm#67 (xtext) ====
Index: perl/ext/threads/threads.pm
--- perl/ext/threads/threads.pm#66~28602~ 2006-07-20 14:36:25.000000000
-0700
+++ perl/ext/threads/threads.pm 2006-07-21 08:27:20.000000000 -0700
@@ -438,7 +438,7 @@
If C<exit()> really is needed, then consider using the following:
- threads->exit() if $threads::threads; # Thread friendly
+ threads->exit() if threads->can('exit'); # Thread friendly
exit(status);
=item use threads 'exit' => 'thread_only'
==== //depot/perl/ext/threads/threads.xs#116 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#115~28602~ 2006-07-20 14:36:25.000000000
-0700
+++ perl/ext/threads/threads.xs 2006-07-21 08:27:20.000000000 -0700
@@ -199,13 +199,16 @@
/* Warn if exiting with any unjoined threads */
-int
+static int
S_exit_warning(pTHX)
{
- int veto_cleanup = 0;
+ int veto_cleanup;
MUTEX_LOCK(&create_destruct_mutex);
- if (running_threads || joinable_threads) {
+ veto_cleanup = (running_threads || joinable_threads);
+ MUTEX_UNLOCK(&create_destruct_mutex);
+
+ if (veto_cleanup) {
if (ckWARN_d(WARN_THREADS)) {
Perl_warn(aTHX_ "Perl exited with active threads:\n\t%"
IVdf " running and unjoined\n\t%"
@@ -215,9 +218,7 @@
joinable_threads,
detached_threads);
}
- veto_cleanup = 1;
}
- MUTEX_UNLOCK(&create_destruct_mutex);
return (veto_cleanup);
}
End of Patch.
