]> git.vpit.fr Git - perl/modules/Test-Leaner.git/blob - t/21-ok-failing.t
Test that ok() really honors 'bool' overloading
[perl/modules/Test-Leaner.git] / t / 21-ok-failing.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7
8 BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
9
10 use Test::Leaner ();
11
12 use lib 't/lib';
13 use Test::Leaner::TestHelper;
14
15 my $buf;
16 capture_to_buffer $buf
17                   or plan skip_all =>'perl 5.8 required to test ok() failing';
18
19 plan tests => 3 * 5;
20
21 reset_buffer {
22  local $@;
23  my $ret = eval { Test::Leaner::ok(0) };
24  is $@,    '',           'ok(0) does not croak';
25  ok !$ret,               'ok(0) returns false';
26  is $buf,  "not ok 1\n", 'ok(0) produces the correct TAP code';
27 };
28
29 reset_buffer {
30  local $@;
31  my $ret = eval { Test::Leaner::ok(undef) };
32  is $@,    '',           'ok(undef) does not croak';
33  ok !$ret,               'ok(undef) returns false';
34  is $buf,  "not ok 2\n", 'ok(undef) produces the correct TAP code';
35 };
36
37 reset_buffer {
38  local $@;
39  my $ret = eval { Test::Leaner::ok(!1) };
40  is $@,    '',           'ok(false) does not croak';
41  ok !$ret,               'ok(false) returns false';
42  is $buf,  "not ok 3\n", 'ok(false) produces the correct TAP code';
43 };
44
45 reset_buffer {
46  local $@;
47  my $ret = eval { Test::Leaner::ok(0, 'this is a comment') };
48  is $@,    '', 'ok(0, "comment") does not croak';
49  ok !$ret,     'ok(0, "comment") returns false';
50  is $buf,  "not ok 4 - this is a comment\n",
51                'ok(0, "comment") produces the correct TAP code';
52 };
53
54 {
55  package Test::Leaner::TestOverload::AlwaysFalse;
56
57  use overload (
58   'bool' => sub { !1 },
59   '""'   => sub { 'true' },
60  );
61
62  sub new { bless { }, shift }
63 }
64
65 my $z = Test::Leaner::TestOverload::AlwaysFalse->new;
66
67 reset_buffer {
68  local $@;
69  my $ret = eval { Test::Leaner::ok($z) };
70  is $@,    '',           'ok($overloaded_false) does not croak';
71  ok !$ret,               'ok($overloaded_false) returns false';
72  is $buf,  "not ok 5\n", 'ok($overloaded_false) produces the correct TAP code';
73 };
74