12 if ($] >= 5.008 and $INC{'threads.pm'}) {
13 my $use_ithreads = do {
16 $Config::Config{useithreads};
19 require threads::shared;
20 *THREADSAFE = sub () { 1 };
23 unless (defined &Test::Leaner::THREADSAFE) {
24 *THREADSAFE = sub () { 0 }
28 my $TAP_STREAM = *STDOUT;
29 my $DIAG_STREAM = *STDERR;
31 my ($plan, $test, $failed, $no_diag, $done_testing);
34 sub SKIP_ALL () { -2 }
38 threads::shared::share($_) for $plan, $test, $failed, $no_diag;
41 lock $plan if THREADSAFE;
49 my $level = 1 + ($Test::Builder::Level || 0);
50 my ($file, $line) = (caller $level)[1, 2];
51 warn @_, " at $file line $line.\n";
55 my $level = 1 + ($Test::Builder::Level || 0);
56 my ($file, $line) = (caller $level)[1, 2];
57 die @_, " at $file line $line.\n";
60 sub sanitize_comment {
67 my ($key, $value) = @_;
71 lock $plan if THREADSAFE;
73 croak("You tried to plan twice") if defined $plan;
77 if ($key eq 'no_plan') {
78 croak("no_plan takes no arguments") if $value;
80 } elsif ($key eq 'tests') {
81 croak("Got an undefined number of tests") unless defined $value;
82 croak("You said to run 0 tests") unless $value;
83 croak("Number of tests must be a positive integer. You gave it '$value'")
84 unless $value =~ /^\+?[0-9]+$/;
86 $plan_str = "1..$value";
87 } elsif ($key eq 'skip_all') {
89 $plan_str = '1..0 # SKIP';
91 sanitize_comment($value);
92 $plan_str .= " $value" if length $value;
95 my @args = grep defined, $key, $value;
96 croak("plan() doesn't understand @args");
100 my $fh = select $TAP_STREAM;
105 if (defined $plan_str) {
107 print $TAP_STREAM "$plan_str\n";
110 exit 0 if $plan == SKIP_ALL;
142 if ($item eq 'import') {
143 push @imports, @{ $_[$i+1] };
145 } elsif ($item eq 'no_diag') {
151 splice @_, $i, $splice;
158 local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1;
162 @_ = ($class, @imports);
163 goto &Exporter::import;
167 @_ = (skip_all => $_[0]);
172 my ($reason, $count) = @_;
174 lock $plan if THREADSAFE;
176 if (not defined $count) {
177 carp("skip() needs to know \$how_many tests are in the block")
178 unless defined $plan and $plan == NO_PLAN;
180 } elsif ($count =~ /[^0-9]/) {
181 carp('skip() was passed a non-numeric number of tests. Did you get the arguments backwards?');
186 my $skip_str = "ok $test # skip";
187 if (defined $reason) {
188 sanitize_comment($reason);
189 $skip_str .= " $reason" if length $reason;
193 print $TAP_STREAM "$skip_str\n";
198 no warnings 'exiting';
205 lock $plan if THREADSAFE;
207 $count = $test unless defined $count;
208 croak("Number of tests must be a positive integer. You gave it '$count'")
209 unless $count =~ /^\+?[0-9]+$/;
211 if (not defined $plan or $plan == NO_PLAN) {
212 $plan = $count; # $plan can't be NO_PLAN anymore
215 print $TAP_STREAM "1..$plan\n";
218 @_ = ('done_testing() was already called');
220 } elsif ($plan != $count) {
221 @_ = ("planned to run $plan tests but done_testing() expects $count");
230 my ($ok, $desc) = @_;
232 lock $plan if THREADSAFE;
236 my $test_str = "ok $test";
238 $test_str = "not $test_str";
242 sanitize_comment($desc);
243 $test_str .= " - $desc" if length $desc;
247 print $TAP_STREAM "$test_str\n";
290 '~~' => 'smartmatch',
293 for my $op (sort keys %binops) {
294 my $name = $binops{$op};
297 sub is_$name (\$\$;\$) {
298 my (\$x, \$y, \$desc) = \@_;
299 \@_ = ((\$x $op \$y), \$desc);
308 my ($got, $expected, $desc) = @_;
309 no warnings 'uninitialized';
311 (not(defined $got xor defined $expected) and $got eq $expected),
318 my ($x, $y, $desc) = @_;
319 no warnings 'uninitialized';
321 ((defined $x xor defined $y) or $x ne $y),
330 *unlike = \&is_unlike;
334 my ($x, $op, $y, $desc) = @_;
335 my $name = $binops{$op};
336 croak("Operator $op not supported") unless defined $name;
337 @_ = ($x, $y, $desc);
339 goto &{__PACKAGE__."::is_$name"};
347 lock $plan if THREADSAFE;
350 my $msg = join '', map { defined($_) ? $_ : 'undef' } @_;
351 sanitize_comment($msg);
352 return unless length $msg;
355 print $fh "# $msg\n";
361 unshift @_, $DIAG_STREAM;
366 unshift @_, $TAP_STREAM;
373 lock $plan if THREADSAFE;
375 my $bail_out_str = 'Bail out!';
377 sanitize_comment($desc);
378 $bail_out_str .= " $desc" if length $desc; # Two spaces
382 print $TAP_STREAM "$bail_out_str\n";
389 lock $plan if THREADSAFE;
393 $? = $failed <= 254 ? $failed : 254;
394 } elsif ($plan >= 0) {
395 $? = $test == $plan ? 0 : 255;
396 } elsif ($plan == NO_PLAN) {
398 print $TAP_STREAM "1..$test\n";
404 1; # End of Test::Leaner