use strict;
use warnings;
=head1 NAME
55-predicates.t - defining new test predicates with Test::Group
=cut
use Test::More tests => 1;
use Test::Group::Tester;
use Test::Group;
use lib "t/lib";
use testlib;
my $scriptline = __LINE__ ; my $script = <<'EOSCRIPT';
use strict;
use warnings;
use Test::Builder;
use Test::Group;
use Test::More;
__FOOBAR_OK__
# foobar_ok_b: a predicate on top of foobar_ok, using the standard
# Test::Builder predicate-within-predicate mechanism.
sub foobar_ok_b {
my ($thing, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
foobar_ok($thing, "$name");
}
# foobar_ok_bg: a Test::Group predicate on top of foobar_ok_b
sub foobar_ok_bg {
my ($text, $name) = @_;
$name ||= "foobar_ok_bg";
local $Test::Builder::Level = $Test::Builder::Level + 1;
test $name => sub {
local $Test::Group::InPredicate = 1;
ok "foo", "foo is true";
foobar_ok_b($text, $name);
ok "bar", "bar is true";
};
}
# foobar_ok_bgb: another layer of predicate
sub foobar_ok_bgb {
my ($thing, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
foobar_ok_bg($thing, $name);
}
foreach my $pred (qw(foobar_ok foobar_ok_b foobar_ok_bg foobar_ok_bgb)) {
# Try the predicate passing
want_test('pass', "pass $pred");
{ no strict 'refs' ; &$pred("foobar", "pass $pred") };
# Try the predicate failing
want_test('fail', "fail $pred",
fail_diag("bar ok"),
qr/^#\s*'foobaz'$/,
qr/\bdoesn't match\b/,
# An extra layer of Test::Group means an extra fail diag:
( $pred =~ /_bg/ ? fail_diag("fail $pred") : () ),
fail_diag("fail $pred", 1, __LINE__+2),
);
{ no strict 'refs' ; &$pred("foobaz", "fail $pred") };
# Passing in a group
want_test('pass', "pass group$pred");
test "pass group$pred" => sub {
no strict 'refs' ; &$pred("foobar", "pass $pred");
};
# Failing in a group
want_test('fail', "fail group$pred",
fail_diag("bar ok"),
qr/^#\s*'foobaz'$/,
qr/\bdoesn't match\b/,
# An extra layer of Test::Group means an extra fail diag:
( $pred =~ /_bg/ ? fail_diag("fail $pred") : () ),
fail_diag("fail $pred", 0, __LINE__+4),
fail_diag("fail group$pred", 1, __LINE__+4),
);
test "fail group$pred" => sub {
no strict 'refs' ; &$pred("foobaz", "fail $pred");
};
}
EOSCRIPT
my $foobar_ok = get_pod_snippet("foobar_ok");
my $hashline = "#line ".($scriptline+8)."\n";
$script =~ s/__FOOBAR_OK__/$foobar_ok\n$hashline/;
testscript_ok($script, 16);