This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Do not propagate END blocks to child threads, test.
authorArtur Bergman <sky@nanisky.com>
Wed, 13 Feb 2002 09:00:24 +0000 (09:00 +0000)
committerArtur Bergman <sky@nanisky.com>
Wed, 13 Feb 2002 09:00:24 +0000 (09:00 +0000)
p4raw-id: //depot/perl@14675

MANIFEST
ext/threads/t/end.t [new file with mode: 0644]
ext/threads/threads.xs

index eac56da..58ec65f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -632,6 +632,7 @@ ext/threads/shared/t/sv_refs.t      thread shared variables
 ext/threads/shared/t/sv_simple.t       thread shared variables
 ext/threads/shared/typemap     thread::shared types
 ext/threads/t/basic.t          ithreads
+ext/threads/t/end.t            Test end functions
 ext/threads/t/libc.t            testing libc functions for threadsafetyness
 ext/threads/t/join.t           Testing the join function
 ext/threads/t/stress_cv.t      Test with multiple threads, coderef cv argument.
diff --git a/ext/threads/t/end.t b/ext/threads/t/end.t
new file mode 100644 (file)
index 0000000..199ca47
--- /dev/null
@@ -0,0 +1,41 @@
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'useithreads'}) {
+        print "1..0 # Skip: no useithreads\n";
+        exit 0;
+    }
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..6\n" };
+use threads;
+use threads::shared;
+
+my $test_id = 1;
+share($test_id);
+use Devel::Peek qw(Dump);
+
+sub ok {
+    my ($ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+    $test_id++;
+    return $ok;
+}
+ok(1);
+END { ok(1,"End block run once") }
+threads->create(sub { eval "END { ok(1,'') }"})->join();
+threads->create(sub { eval "END { ok(1,'') }"})->join();
+threads->create(\&thread)->join();
+
+sub thread {
+       eval "END { ok(1,'') }";
+       threads->create(sub { eval "END { ok(1,'') }"})->join();
+}
index 83dca93..88f2c04 100755 (executable)
@@ -315,7 +315,11 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
         */
        {
            dTHXa(thread->interp);
-
+            /* Here we remove END blocks since they should only run
+              in the thread they are created 
+            */
+            SvREFCNT_dec(PL_endav);
+            PL_endav = newAV();
             clone_param.flags = 0;
            thread->init_function = sv_dup(init_function, &clone_param);
            if (SvREFCNT(thread->init_function) == 0) {