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 no warnings 'uninitialized';
301 (not(defined \$x xor defined \$y) and \$x $op \$y),
315 *unlike = \&is_unlike;
319 my ($x, $y, $desc) = @_;
320 no warnings 'uninitialized';
322 ((defined $x xor defined $y) or $x ne $y),
329 my ($x, $op, $y, $desc) = @_;
330 my $name = $binops{$op};
331 croak("Operator $op not supported") unless defined $name;
332 @_ = ($x, $y, $desc);
334 goto &{__PACKAGE__."::is_$name"};
342 lock $plan if THREADSAFE;
345 my $msg = join '', map { defined($_) ? $_ : 'undef' } @_;
346 sanitize_comment($msg);
347 return unless length $msg;
350 print $fh "# $msg\n";
356 unshift @_, $DIAG_STREAM;
361 unshift @_, $TAP_STREAM;
368 lock $plan if THREADSAFE;
370 my $bail_out_str = 'Bail out!';
372 sanitize_comment($desc);
373 $bail_out_str .= " $desc" if length $desc; # Two spaces
377 print $TAP_STREAM "$bail_out_str\n";
384 lock $plan if THREADSAFE;
388 $? = $failed <= 254 ? $failed : 254;
389 } elsif ($plan >= 0) {
390 $? = $test == $plan ? 0 : 255;
391 } elsif ($plan == NO_PLAN) {
393 print $TAP_STREAM "1..$test\n";
399 1; # End of Test::Leaner