All the Perl that's Practical to Extract and Report

Cool hack: annotating compatibility in test suites

ChrisDolan on 2007-11-16T04:56:51

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):

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');
}


So up-to-date client code does this:

Test::Virtual::Filesystem->new('.', '0.02')->runtests;
# yields:
# ok 1 - path exists
# ok 2 - path is a dir


while old client code does this:

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

Nice Job!

Ovid on 2007-11-16T09:56:34

This is a very interesting little hack. We did something similar at one job where we added a 'DB' attribute to our tests and our test database would only be built if said attribute was found. Nifty little speedup. I love seeing more cool stuff for my favorite testing module.

Re:Nice Job!

ChrisDolan on 2007-11-16T12:57:03

I added another one after writing that blog. The version headed to CPAN right now has a :Features('foo,bar') attribute to let clients turn on and off swaths of tests. For example, 'symlink' is one of the features, 'xattr' is another. If a feature is not enabled, I call skip on the method, and Test::Class offers a nice hook to fetch the number of tests to skip.