From: Graham Knop <haarg@haarg.org>
Date: Tue, 23 Jul 2013 16:10:26 +0000 (-0400)
Subject: tests for Sub::Quote/Sub::Defer in threads
X-Git-Tag: v1.003001~30
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc7c20a05f2d0112ed3ae7df2e3172209bd1fd09;p=gitmo%2FMoo.git

tests for Sub::Quote/Sub::Defer in threads
---

diff --git a/t/sub-defer-threads.t b/t/sub-defer-threads.t
new file mode 100644
index 0000000..a9f5dd6
--- /dev/null
+++ b/t/sub-defer-threads.t
@@ -0,0 +1,29 @@
+use strictures 1;
+use Test::More;
+use Config;
+BEGIN {
+  unless ($Config{useithreads} && eval { require threads } ) {
+    plan skip_all => "your perl does not support ithreads";
+  }
+}
+
+use Sub::Defer;
+
+my %made;
+
+my $one_defer = defer_sub 'Foo::one' => sub {
+  die "remade - wtf" if $made{'Foo::one'};
+  $made{'Foo::one'} = sub { 'one' }
+};
+
+ok(threads->create(sub {
+  my $info = Sub::Defer::defer_info($one_defer);
+  $info && $info->[0] eq 'Foo::one';
+})->join, 'able to retrieve info in thread');
+
+ok(threads->create(sub {
+  undefer_sub($one_defer);
+  $made{'Foo::one'} && $made{'Foo::one'} == \&Foo::one;
+})->join, 'able to undefer in thread');
+
+done_testing;
diff --git a/t/sub-quote-threads.t b/t/sub-quote-threads.t
new file mode 100644
index 0000000..ecd8b2e
--- /dev/null
+++ b/t/sub-quote-threads.t
@@ -0,0 +1,45 @@
+use strictures 1;
+use Test::More;
+use Config;
+BEGIN {
+  unless ($Config{useithreads} && eval { require threads } ) {
+    plan skip_all => "your perl does not support ithreads";
+  }
+}
+
+use Sub::Quote;
+
+my $one = quote_sub my $one_code = q{
+    BEGIN { $::EVALED{'one'} = 1 }
+    42
+};
+
+my $two = quote_sub q{
+    BEGIN { $::EVALED{'two'} = 1 }
+    3 + $x++
+} => { '$x' => \do { my $x = 0 } };
+
+ok(threads->create(sub {
+  my $quoted = quoted_from_sub($one);
+  $quoted && $quoted->[1] eq $one_code;
+})->join, 'able to retrieve quoted sub in thread');
+
+my $u_one = unquote_sub $one;
+
+is(threads->create(sub { $one->() })->join, 42, 'One (quoted version)');
+
+is(threads->create(sub { $u_one->() })->join, 42, 'One (unquoted version)');
+
+my $r = threads->create(sub {
+  my @r;
+  push @r, $two->();
+  push @r, unquote_sub($two)->();
+  push @r, $two->();
+  \@r;
+})->join;
+
+is($r->[0], 3, 'Two in thread (quoted version)');
+is($r->[1], 4, 'Two in thread (unquoted version)');
+is($r->[2], 5, 'Two in thread (quoted version again)');
+
+done_testing;