plan(24); # 2 tests { my $ran := 0; my $t := nqp::newthread({ $ran := 1 }, 0); ok(nqp::defined($t), 'Can create a new non-app-lifetime thread'); nqp::threadrun($t); nqp::threadjoin($t); ok($ran, 'Can run and join the new thread'); } # 2 tests { my $start := nqp::time(); my $t := nqp::newthread({ nqp::sleep(10.0) }, 1); ok(nqp::defined($t), 'Can create a new app-lifetime thread'); nqp::threadrun($t); ok(nqp::islt_i(nqp::sub_i(nqp::time(), $start), 10*1000000000), 'Sleeping app-lifetime thread does not block main thread'); } # 4 tests { my int $done := 0; my $t := nqp::newthread({ 1 until $done; ok(1, 'Can write to STDOUT in child thread'); }, 0); ok(1, 'Can write to STDOUT in parent thread before threadrun'); nqp::threadrun($t); ok(1, 'Can write to STDOUT in parent thread after threadrun'); $done := 1; nqp::threadjoin($t); ok(1, 'Can write to STDOUT in parent thread after threadjoin'); } # 9 tests { my $c := nqp::currentthread(); my $pid := nqp::threadid($c); ok($pid, 'Parent thread has a non-zero ID'); my $tid := 0; my $cid := 0; my $t := nqp::newthread({ $cid := nqp::threadid(nqp::currentthread()); }, 0); ok(nqp::defined($t), 'Can create another new thread after previous joins'); $tid := nqp::threadid($t); ok($tid, 'New thread has a non-zero ID'); ok($tid != $pid, 'Parent and new thread have different IDs'); nqp::threadrun($t); ok($tid == nqp::threadid($t), 'Thread keeps same ID after threadrun()'); nqp::threadjoin($t); ok($tid == nqp::threadid($t), 'Thread keeps same ID after threadjoin()'); ok($cid, 'Child thread knew its own thread ID'); ok($cid == $tid, 'Parent saw same ID for child as child did'); ok($pid == nqp::threadid(nqp::currentthread()), 'Parent thread still has the same ID'); } # 3 tests { my $a := 0; my $b := 0; my $t1 := nqp::newthread({ $a := 21 }, 0); my $t2 := nqp::newthread({ $b := 42 }, 0); nqp::threadrun($t1); nqp::threadrun($t2); ok(nqp::threadid($t1) != nqp::threadid($t2), 'Two new child threads have different IDs'); nqp::threadjoin($t1); nqp::threadjoin($t2); ok($a == 21, 'First child thread actually ran'); ok($b == 42, 'Second child thread also ran'); } # 2 tests # Parent-child case for threadyield() # This test intentionally does not use proper synchronization primitives, # so that threadyield can be tested independently of locks/condvars/etc. { my @a; my $t := nqp::newthread({ nqp::threadyield() until nqp::elems(@a) == 1 && @a[0] eq 'a'; nqp::push(@a, '1'); nqp::threadyield() until nqp::elems(@a) == 3 && @a[2] eq 'b'; nqp::push(@a, '2'); }, 0); # Make sure child thread is at least *runnable* (if not actually running) # before running parent thread's code. nqp::threadrun($t); { nqp::push(@a, 'a'); nqp::threadyield() until nqp::elems(@a) == 2 && @a[1] eq '1'; nqp::push(@a, 'b'); nqp::threadyield() until nqp::elems(@a) == 4 && @a[3] eq '2'; nqp::push(@a, 'c'); } nqp::threadjoin($t); ok(@a[0] eq 'a', 'Looped threadyield() can force parent thread to act first'); my $order := nqp::join(',', @a); my $ok := $order eq 'a,1,b,2,c'; ok($ok, 'threadyield() properly interleaved parent and child threads'); say("# execution order = $order (expected a,1,b,2,c)") if !$ok; } # 2 tests # Sibling child threads case for threadyield() # This test intentionally does not use proper synchronization primitives, # so that threadyield can be tested independently of locks/condvars/etc. { my @a; my $t1 := nqp::newthread({ nqp::push(@a, 'a'); nqp::threadyield() until nqp::elems(@a) == 2 && @a[1] eq '1'; nqp::push(@a, 'b'); nqp::threadyield() until nqp::elems(@a) == 4 && @a[3] eq '2'; nqp::push(@a, 'c'); }, 0); my $t2 := nqp::newthread({ nqp::threadyield() until nqp::elems(@a) == 1 && @a[0] eq 'a'; nqp::push(@a, '1'); nqp::threadyield() until nqp::elems(@a) == 3 && @a[2] eq 'b'; nqp::push(@a, '2'); }, 0); # Make sure $t2 is at least *runnable* (if not actually running) # before $t1 becomes runnable. nqp::threadrun($t2); nqp::threadrun($t1); # Join in either order should work here. nqp::threadjoin($t1); nqp::threadjoin($t2); ok(@a[0] eq 'a', 'Looped threadyield() can force other thread to act first'); my $order := nqp::join(',', @a); my $ok := $order eq 'a,1,b,2,c'; ok($ok, 'threadyield() properly interleaved two child threads'); say("# execution order = $order (expected a,1,b,2,c)") if !$ok; } # XXXX: Stress tests -- Perl 6 spectests starting at S17-lowlevel/thread.t:100