1package Test2::Tools::Basic;
2use strict;
3use warnings;
4
5our $VERSION = '0.000162';
6
7use Carp qw/croak/;
8use Test2::API qw/context/;
9
10our @EXPORT = qw{
11    ok pass fail diag note todo skip
12    plan skip_all done_testing bail_out
13};
14use base 'Exporter';
15
16sub ok($;$@) {
17    my ($bool, $name, @diag) = @_;
18    my $ctx = context();
19    $ctx->ok($bool, $name, \@diag);
20    $ctx->release;
21    return $bool ? 1 : 0;
22}
23
24sub pass {
25    my ($name) = @_;
26    my $ctx = context();
27    $ctx->ok(1, $name);
28    $ctx->release;
29    return 1;
30}
31
32sub fail {
33    my ($name, @diag) = @_;
34    my $ctx = context();
35    $ctx->ok(0, $name, \@diag);
36    $ctx->release;
37    return 0;
38}
39
40sub diag {
41    my $ctx = context();
42    $ctx->diag( join '', grep { defined $_ } @_ );
43    $ctx->release;
44    return 0;
45}
46
47sub note {
48    my $ctx = context();
49    $ctx->note( join '', grep { defined $_ } @_ );
50    $ctx->release;
51}
52
53sub todo {
54    my $reason = shift;
55    my $code   = shift;
56
57    require Test2::Todo unless $INC{'Test2/Todo.pm'};
58    my $todo = Test2::Todo->new(reason => $reason);
59
60    return $code->() if $code;
61
62    croak "Cannot use todo() in a void context without a codeblock"
63        unless defined wantarray;
64
65    return $todo;
66}
67
68sub skip {
69    my ($why, $num) = @_;
70    $num ||= 1;
71    my $ctx = context();
72    $ctx->skip("skipped test", $why) for 1 .. $num;
73    $ctx->release;
74    no warnings 'exiting';
75    last SKIP;
76}
77
78sub plan {
79    my $plan = shift;
80    my $ctx = context();
81
82    if ($plan && $plan =~ m/[^0-9]/) {
83        if ($plan eq 'tests') {
84            $plan = shift;
85        }
86        elsif ($plan eq 'skip_all') {
87            skip_all(@_);
88            $ctx->release;
89            return;
90        }
91    }
92
93    $ctx->plan($plan);
94    $ctx->release;
95}
96
97sub skip_all {
98    my ($reason) = @_;
99    my $ctx = context();
100    $ctx->plan(0, SKIP => $reason);
101    $ctx->release if $ctx;
102}
103
104sub done_testing {
105    my $ctx = context();
106    $ctx->hub->finalize($ctx->trace, 1);
107    $ctx->release;
108}
109
110sub bail_out {
111    my ($reason) = @_;
112    my $ctx = context();
113    $ctx->bail($reason);
114    $ctx->release if $ctx;
115}
116
1171;
118
119__END__
120
121=pod
122
123=encoding UTF-8
124
125=head1 NAME
126
127Test2::Tools::Basic - Test2 implementation of the basic testing tools.
128
129=head1 DESCRIPTION
130
131This is a L<Test2> based implementation of the more basic tools originally
132provided by L<Test::More>. Not all L<Test::More> tools are provided by this
133package, only the basic/simple ones. Some tools have been modified for better
134diagnostics capabilities.
135
136=head1 SYNOPSIS
137
138    use Test2::Tools::Basic;
139
140    ok($x, "simple test");
141
142    if ($passing) {
143        pass('a passing test');
144    }
145    else {
146        fail('a failing test');
147    }
148
149    diag "This is a diagnostics message on STDERR";
150    note "This is a diagnostics message on STDOUT";
151
152    {
153        my $todo = todo "Reason for todo";
154        ok(0, "this test is todo");
155    }
156
157    ok(1, "this test is not todo");
158
159    todo "reason" => sub {
160        ok(0, "this test is todo");
161    };
162
163    ok(1, "this test is not todo");
164
165    SKIP: {
166        skip "This will wipe your drive";
167
168        # This never gets run:
169        ok(!system('sudo rm -rf /'), "Wipe drive");
170    }
171
172    done_testing;
173
174=head1 EXPORTS
175
176All subs are exported by default.
177
178=head2 PLANNING
179
180=over 4
181
182=item plan($num)
183
184=item plan('tests' => $num)
185
186=item plan('skip_all' => $reason)
187
188Set the number of tests that are expected. This must be done first or last,
189never in the middle of testing.
190
191For legacy compatibility you can specify 'tests' as the first argument before
192the number. You can also use this to skip all with the 'skip_all' prefix,
193followed by a reason for skipping.
194
195=item skip_all($reason)
196
197Set the plan to 0 with a reason, then exit true. This should be used before any
198tests are run.
199
200=item done_testing
201
202Used to mark the end of testing. This is a safe way to have a dynamic or
203unknown number of tests.
204
205=item bail_out($reason)
206
207Invoked when something has gone horribly wrong: stop everything, kill all threads and
208processes, end the process with a false exit status.
209
210=back
211
212=head2 ASSERTIONS
213
214=over 4
215
216=item ok($bool)
217
218=item ok($bool, $name)
219
220=item ok($bool, $name, @diag)
221
222Simple assertion. If C<$bool> is true the test passes, and if it is false the test
223fails. The test name is optional, and all arguments after the name are added as
224diagnostics message if and only if the test fails. If the test passes all the
225diagnostics arguments will be ignored.
226
227=item pass()
228
229=item pass($name)
230
231Fire off a passing test (a single Ok event). The name is optional
232
233=item fail()
234
235=item fail($name)
236
237=item fail($name, @diag)
238
239Fire off a failing test (a single Ok event). The name and diagnostics are optional.
240
241=back
242
243=head2 DIAGNOSTICS
244
245=over 4
246
247=item diag(@messages)
248
249Write diagnostics messages. All items in C<@messages> will be joined into a
250single string with no separator. When using TAP, diagnostics are sent to STDERR.
251
252Returns false, so as to preserve failure.
253
254=item note(@messages)
255
256Write note-diagnostics messages. All items in C<@messages> will be joined into
257a single string with no separator. When using TAP, notes are sent to STDOUT.
258
259=back
260
261=head2 META
262
263=over 4
264
265=item $todo = todo($reason)
266
267=item todo $reason => sub { ... }
268
269This is used to mark some results as TODO. TODO means that the test may fail,
270but will not cause the overall test suite to fail.
271
272There are two ways to use this. The first is to use a codeblock, and the TODO will
273only apply to the codeblock.
274
275    ok(1, "before"); # Not TODO
276
277    todo 'this will fail' => sub {
278        # This is TODO, as is any other test in this block.
279        ok(0, "blah");
280    };
281
282    ok(1, "after"); # Not TODO
283
284The other way is to use a scoped variable. TODO will end when the variable is
285destroyed or set to undef.
286
287    ok(1, "before"); # Not TODO
288
289    {
290        my $todo = todo 'this will fail';
291
292        # This is TODO, as is any other test in this block.
293        ok(0, "blah");
294    };
295
296    ok(1, "after"); # Not TODO
297
298This is the same thing, but without the C<{...}> scope.
299
300    ok(1, "before"); # Not TODO
301
302    my $todo = todo 'this will fail';
303
304    ok(0, "blah"); # TODO
305
306    $todo = undef;
307
308    ok(1, "after"); # Not TODO
309
310=item skip($why)
311
312=item skip($why, $count)
313
314This is used to skip some tests. This requires you to wrap your tests in a
315block labeled C<SKIP:>. This is somewhat magical. If no C<$count> is specified
316then it will issue a single result. If you specify C<$count> it will issue that
317many results.
318
319    SKIP: {
320        skip "This will wipe your drive";
321
322        # This never gets run:
323        ok(!system('sudo rm -rf /'), "Wipe drive");
324    }
325
326=back
327
328=head1 SOURCE
329
330The source code repository for Test2-Suite can be found at
331F<https://github.com/Test-More/Test2-Suite/>.
332
333=head1 MAINTAINERS
334
335=over 4
336
337=item Chad Granum E<lt>exodist@cpan.orgE<gt>
338
339=back
340
341=head1 AUTHORS
342
343=over 4
344
345=item Chad Granum E<lt>exodist@cpan.orgE<gt>
346
347=back
348
349=head1 COPYRIGHT
350
351Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.
352
353This program is free software; you can redistribute it and/or
354modify it under the same terms as Perl itself.
355
356See F<http://dev.perl.org/licenses/>
357
358=cut
359