Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

ChrisDolan (2855)

ChrisDolan
  (email not shown publicly)
http://www.chrisdolan.net/

Journal of ChrisDolan (2855)

Thursday November 15, 2007
11:56 PM

Cool hack: annotating compatibility in test suites

[ #34906 ]

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

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • 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.

    • 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.