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;
141 if ($item eq 'import') {
142 push @imports, @{ $_[$i+1] };
144 } elsif ($item eq 'no_diag') {
150 splice @_, $i, $splice;
157 local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1;
161 @_ = ($class, @imports);
162 goto &Exporter::import;
166 @_ = (skip_all => $_[0]);
171 my ($reason, $count) = @_;
173 lock $plan if THREADSAFE;
175 if (not defined $count) {
176 carp("skip() needs to know \$how_many tests are in the block")
177 unless defined $plan and $plan == NO_PLAN;
179 } elsif ($count =~ /[^0-9]/) {
180 carp('skip() was passed a non-numeric number of tests. Did you get the arguments backwards?');
185 my $skip_str = "ok $test # skip";
186 if (defined $reason) {
187 sanitize_comment($reason);
188 $skip_str .= " $reason" if length $reason;
192 print $TAP_STREAM "$skip_str\n";
197 no warnings 'exiting';
204 lock $plan if THREADSAFE;
206 $count = $test unless defined $count;
207 croak("Number of tests must be a positive integer. You gave it '$count'")
208 unless $count =~ /^\+?[0-9]+$/;
210 if (not defined $plan or $plan == NO_PLAN) {
211 $plan = $count; # $plan can't be NO_PLAN anymore
214 print $TAP_STREAM "1..$plan\n";
217 @_ = ('done_testing() was already called');
219 } elsif ($plan != $count) {
220 @_ = ("planned to run $plan tests but done_testing() expects $count");
229 my ($ok, $desc) = @_;
231 lock $plan if THREADSAFE;
235 my $test_str = "ok $test";
237 $test_str = "not $test_str";
241 sanitize_comment($desc);
242 $test_str .= " - $desc" if length $desc;
246 print $TAP_STREAM "$test_str\n";
289 '~~' => 'smartmatch',
292 for my $op (sort keys %binops) {
293 my $name = $binops{$op};
296 sub is_$name (\$\$;\$) {
297 my (\$x, \$y, \$desc) = \@_;
298 no warnings 'uninitialized';
300 (not(defined \$x xor defined \$y) and \$x $op \$y),
314 *unlike = \&is_unlike;
318 my ($x, $y, $desc) = @_;
319 no warnings 'uninitialized';
321 ((defined $x xor defined $y) or $x ne $y),
328 my ($x, $op, $y, $desc) = @_;
329 my $name = $binops{$op};
330 croak("Operator $op not supported") unless defined $name;
331 @_ = ($x, $y, $desc);
333 goto &{__PACKAGE__."is_$name"};
341 lock $plan if THREADSAFE;
344 my $msg = join '', map { defined($_) ? $_ : 'undef' } @_;
345 sanitize_comment($msg);
346 return unless length $msg;
349 print $fh "# $msg\n";
355 unshift @_, $DIAG_STREAM;
360 unshift @_, $TAP_STREAM;
367 lock $plan if THREADSAFE;
369 my $bail_out_str = 'Bail out!';
371 sanitize_comment($desc);
372 $bail_out_str .= " $desc" if length $desc; # Two spaces
376 print $TAP_STREAM "$bail_out_str\n";
383 lock $plan if THREADSAFE;
387 $? = $failed <= 254 ? $failed : 254;
388 } elsif ($plan >= 0) {
389 $? = $test == $plan ? 0 : 255;
390 } elsif ($plan == NO_PLAN) {
392 print $TAP_STREAM "1..$test\n";
398 1; # End of Test::Leaner