Here's a fun bit of code that I didn't really expect to work. It flags a test as TODO only if client code indicates that it's designed for an older version of a test suite.
Background: I'm working on Test::Virtual::Filesystem, which is a collection of generic tests that exercise a filesystem with typical actions like open, read, write, stat, unlink, mkdir, etc. Users of this code will run it in a .t file to ensure that their filesystem works. But what if I change Test::Virtual::Filesystem to add a new test that breaks some filesystem published on CPAN that used to work with the old version of the test suite?
To solve this, Test::Virtual::Filesystem is written like so (trimmed heavily for readability):
So up-to-date client code does this:use Attribute::Handlers;
use Test::More;
use base 'Test::Class';
sub new {
my ($pkg, $test_dir, $compatible_version) = @_;
my $self = $pkg->SUPER::new();
$self->{test_dir} = $test_dir;
$self->{compatible} = $compatible_version;
return $self;
}
sub Introduced : ATTR(CODE) {
my ($class, $symbol, $code_ref, $attr, $introduced_version) = @_;
# Wrap the sub in a version test
no warnings 'redefine';
*{$symbol} = sub {
local $TODO = $_[0]->_compatible($introduced_version);
$code_ref->(@_);
};
}
sub _compatible {
my ($self, $introduced_version) = @_;
return if !$self->{compatible};
return if $introduced_version le $self->{compatible};
return 'compatibility mode ' . $self->{compatible};
}
sub stat_dir : Test(2) : Introduced('0.02') {
my ($self) = @_;
ok(-e $self->{test_dir}, 'path exists');
ok(-d $self->{test_dir}, 'path is a dir');
}
while old client code does this:Test::Virtual::Filesystem->new('.', '0.02')->runtests;
# yields:
# ok 1 - path exists
# ok 2 - path is a dir
Test::Virtual::Filesystem->new('.', '0.01')->runtests;
# yields:
# ok 1 - path exists # TODO compatibility mode 0.01
# ok 2 - path is a dir # TODO compatibility mode 0.01
