[ SEA-GHOST MINI SHELL]
#!/usr/bin/perl -w
# Test the use of subtest() to define new test predicates that combine
# multiple existing predicates.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::More tests => 4;
use Test::Builder;
use Test::Builder::Tester;
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
our %line;
# Define a new test predicate with Test::More::subtest(), using
# Test::More predicates as building blocks...
sub foobar_ok ($;$) {
my ($value, $name) = @_;
$name ||= "foobar_ok";
local $Test::Builder::Level = $Test::Builder::Level + 1;
subtest $name => sub {
plan tests => 2;
ok $value =~ /foo/, "foo";
ok $value =~ /bar/, "bar"; BEGIN{ $line{foobar_ok_bar} = __LINE__ }
};
}
{
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{foobar_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
foobar_ok "foot", "namehere";
test_test("foobar_ok failing line numbers");
}
# Wrap foobar_ok() to make another new predicate...
sub foobar_ok_2 ($;$) {
my ($value, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
foobar_ok($value, $name);
}
{
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{foobar_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
foobar_ok_2 "foot", "namehere";
test_test("foobar_ok_2 failing line numbers");
}
# Define another new test predicate, this time using
# Test::Builder::subtest() rather than Test::More::subtest()...
sub barfoo_ok ($;$) {
my ($value, $name) = @_;
$name ||= "barfoo_ok";
Test::Builder->new->subtest($name => sub {
plan tests => 2;
ok $value =~ /foo/, "foo";
ok $value =~ /bar/, "bar"; BEGIN{ $line{barfoo_ok_bar} = __LINE__ }
});
}
{
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{barfoo_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
barfoo_ok "foot", "namehere";
test_test("barfoo_ok failing line numbers");
}
# Wrap barfoo_ok() to make another new predicate...
sub barfoo_ok_2 ($;$) {
my ($value, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
barfoo_ok($value, $name);
}
{
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{barfoo_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
barfoo_ok_2 "foot", "namehere";
test_test("barfoo_ok_2 failing line numbers");
}
# A subtest-based predicate called from within a subtest
{
test_out(" 1..2");
test_out(" ok 1 - this passes");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{barfoo_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out(" not ok 2 - namehere");
test_err(" # Failed test 'namehere'");
test_err(" # at $0 line $line{ipredcall}.");
test_out("not ok 1 - outergroup");
test_err("# Failed test 'outergroup'");
test_err("# at $0 line $line{outercall}.");
subtest outergroup => sub {
plan tests => 2;
ok 1, "this passes";
barfoo_ok_2 "foot", "namehere"; BEGIN{ $line{ipredcall} = __LINE__ }
}; BEGIN{ $line{outercall} = __LINE__ }
}
SEA-GHOST - SHELL CODING BY SEA-GHOST