Test::EnhancedIs

Sep 4, 2009

The other day I made an idiot out of myself on IRC. Now this isn't exactly news, but the way I did so is interesting. It seemed to me that Test::More's is was unexpectedly failing when it was passed identical inputs. Having pondered over the issue for a good while, I turned to greater minds than myself for enlightenment; Thus I pastied this output to the London Perl Monger's IRC channel:

bash$ perl -Ilib t/01multi.t 
1..3
ok 1 - data okay
not ok 2 - ip
#   Failed test 'ip'
#   at t/01multi.t line 61.
#          got: '123.45.67.98'
#     expected: '123.45.67.89'
ok 3 - port
# Looks like you failed 1 test of 3.

Can you spot the obvious mistake? I didn't. Of course, being a bunch of pedantic so-and-sos the London Perl Mongers are they immediately pointed out that "89" is not the same as "98", and that's why the tests were failing....Ooops. But wait? Why should I have to spot that. That's not very lazy. Shouldn't this comparing strings kind of thing be exactly what the computer is good at, and darn it, why can't it just point out where the string starts being different, preferably with a big flashing arrow, a klaxon, and a troupe of dancing girls... We can't quite manage that, but with my new module, we can get a lot closer:

travis-4:Babel-WideLog mark$ perl -MTest::EnhancedIs -Ilib t/01multi.t 
1..3
ok 1 - data okay
not ok 2 - ip
#   Failed test 'ip'
#   at t/01multi.t line 61.
#          got: '123.45.67.*98'
#     expected: '123.45.67.*89'
ok 3 - port
# Looks like you failed 1 test of 3.

Yep, a white dot on a red background. The universal Look at Me!. Actually, I did start by just making dot red, but then that wasn't as clear when you're running under prove which already colourises your output. Sadly, the implementation of Test::EnhancedIs leaves a lot to be desired, and is really a proof of concept rather than what I'd consider actual safe, shippable code. Let's have a look at the actual code and try not to wince too much:

package Test::EnhancedIs;
use base qw(Devel::UseFromCommandLineOnly);

use strict;
use warnings;
no warnings "redefine"; ## no critic (ProhibitNoWarnings)

our $VERSION = 0.00_01;

use Term::ANSIColor qw(colored);
use List::Util qw(min);

use Test::Builder;

# remember the original subroutine.  Note the BEGIN { } here - this is because
# without it this code will be run after the sub Test::Builder::_is_diag
# has been declared and we'll grab a ref to the wrong subroutine
my $uboat;
BEGIN { $uboat = \&Test::Builder::_is_diag }; ## no critic (ProtectPrivateVars)

# now write a new subroutine, overriding the subroutine in another package
# don't try this at home kids.
sub Test::Builder::_is_diag { ## no critic (ProtectPrivateSubs)
  my( $self, $got, $type, $expect ) = @_;

  # look for either a different character, or the end of either string
  my $index;
  foreach (0..min(length $got,length $expect)) {
    $index = $_;
    last if substr($got,$index,1) ne substr($expect,$index,1);
  }

  # put a marker in there
  substr($got,$index,0,colored("*","white on_red"));
  substr($expect,$index,0,colored("*","white on_red"));

  # run the original code
  return $uboat->($self,$got,$type,$expect);
}

1;

As you can tell from the comments, we're really breaking the rules here. Anything that disables warnings like that and requires multiple Perl Critic tests to be disabled is more than a little bit worrying! The worst of it is that we're redefining a private function that's inside the Test::Builder namespace. By convention any method or function that starts with an underscore in Perl is considered to be private and can change between versions of the code without notice, meaning that this code will probably not work on different versions of Test::Builder than the one I have installed (which is the latest) - including future versions that are yet to be released. Still, as long as we're aware of the pitfalls this isn't too bad a snippet to have around to fire up from the command line for one off tests when our eyes start to glaze over, at least until it next breaks again. We'll just have to be careful not to include it in any commands or scripts we save to disk, lest we start to rely on it. Of course the real solution is to take this proof of concept to the Perl-QA guys and gals and ask them how we can get best this functionality integrated properly into the next release of Test::Builder. That's a task for another day however.