Who tests the tester? Me !!!

As already reported, I'm writing this color library. Recently I created my own test function for it. And since it was easier that I thought, I want to show you how, so you can write your own!

The Task

If you look into the GTC internals, you see instantly that the most common none OO data structure is a 'tuple' with the values of one color in one color space (usually three values). Since we do not have a native tuple type in Perl - it is an ordinary Array, one could also say a value vector. In the GTC test suite they get checked very often. Each time I have to ask:

  1. Did I get an Array ?
  2. Does it have the right amount of values ?
  3. Check every value of the tuple for equality.

These are usually 5 lines that could and should have been one line. In practice this means 200 rows of test code will shrink to 40 - neat. Less to type, less to read - wonderful. And the assertions will be more to the point telling WHAT I want to test and WHY not just two values match, which is also good for readability and clarity on the other end. If running the tests, the ok - messages will tell me what is actually tested and not that two values matched. But the most important improvement comes to light when something goes wrong. Let's say the function we test collapses and returns undef. The first test will tell us that we got no ARRAY, good, but the next who checks the lengths of the array will crash in a hard syntax error. You have to fix the causing bug in order to see the next test results because your test suite crashed. Wouldn't it be so much nicer the test suite could run to the end and the error messages tell you about all the bugs at once, so you could theoretically hunt them in one go.

You see: less code, clearer code, better error message, only relevant error messages and no hard crashes. These are more than enough motivating reasons to write custom error functions, so let's do it, let's write a variant of

is( $got, $expected, $test_name );

(which is a test function you all used at some point) and name it:

is_tuple( $got, $expected, $axis, $test_name );

You notice I needed one more argument for the axis names. So I can get the nice error message: "the red value was 13 but I expected 15".

The Solution

The Module you need to create that is Test::Builder. So the smart ones among you have guessed you need to:

use Test::Builder;
my $tb = Test::Builder->new;

You can also subclass Test::Builder but this works as well, since ->new will give you the only instance of $tb anyway. And to start our test function we need just:

sub is_tuple {
my ($got, $expected, $axis, $name) = @_;
my $pass = 0;
my $diag = '';

Well if you are reading this blog, you know about Perl argument handling. $pass is the pseudo boolean than holds the information if the test was successful, we pass it on to the Test::Builder method at the end. Same is true for $diag, which is the error message we maybe have to drop. This is not the way you have to do it. Calling the diag method several times is also an option, but i prefer to have short error messages that fits in one line and only tells me what exactly went wrong. Let's skip the testing logic, since a bunch of nested if statements with some basic value checks isn't that impressive and educational. I just like a clean separation between out test logic and the part where I talk to Test::Builder. That is why I declared the variables at the start, fill them when i need to, so I only call the following once at the end of the subroutine:

$tb->diag( $diag ) unless $pass;
$tb->ok( $pass, $name );

Yes that is all. Do not forget to:

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(is_tuple);

But this was really it. It didn't even hurt and we didn't have to see Detroit.

The Tests

More challenging I found it to write the test file that checks the logic code I didn't show in the above example.

use v5......;
use warnings;
use lib '.',...;
use Test::More tests => ...;
use Test::Builder::Tester;
use Test::Color;

This is mostly your usual start template of any test file. The lib pragma needs to receive the directory where the module lives, that contains is_tuple, which would be in my case Test::Color. And we need Test::Builder::Tester to test what we built with Test::Builder (the module names fit).

test_out("ok 1 - is_tuple runs");
is_tuple([1,1,1], [1,1,1], [qw/red green blue/], 'is_tuple runs');
test_test("simplest is_tuple case runs");

Our first little smoke test seems trivial. We call is_tuple with the the result values of some operation ($got) and the values to check them against ($expected), then the axis names and at last the test name (the name of the test is_tuple performs). But BEFORE that you HAVE TO tell Test::Builder::Tester what output to expect from the test function is_tuple on STDOUT. The last line tells Test::Builder::Tester the name of the test we did by testing the test function. That HAS to come AFTER calling is_tuple.

Now we are ready for the juicy bit. How to test a failing test? I mean by that: is_tuple will fail because we gave it bad data by purpose. And if is_tuple tries to give the right error message to STDERR (standard error output), Test::Builder::Tester should intervene and call it a successful test to STDOUT. The code to do this is:

test_out("not ok 1 - C");
test_err("# failed test: C - got values that are not a tuple (ARRAY ref)");
test_fail(+1);
is_tuple(1, [1,1,1], [qw/red green blue/], 'C');
test_test("is_tuple checks if got values in an ARRAY");

First we tell via test_out again what STDOUT suppose to receive. Then we tell via test_err what error message should land in STDERR. And when a test fails Test::Builder will create an additional error message telling where it happened. In order to not have to chase line numbers we got the convenience function: test_fail(+1); You can translate it to: "Hej Test::Builder::Tester, the next line (+1) will cause an error, this is fine, please do not create this additional error with the line number". What actually happens is, this call gets forwarded to a test_err call with the appropriate string that contains the right line number. Then we finally call the test function we want to test and at the very end again - the name of this (meta) test.

One last useful hack. You noticed I called the test that is_tuple does in the last example just uppercase C. This is not a nice and telling name for any test and brutally counterproductive - However - since we testing the test and the name of the inner test is part of the STDOUT and STDERR check string in the outer test, it is nice to trace easily what substring comes from where and this is also rather educational for this demo. What this (inner) test suppose to do is documented anyway by the name of the outer test.

7 Comments

"...we do not have a native tuple type in Perl ..." And I don't think that we want one.

When I ask the wonderful Google AI, "[what is] the relationship between abstract data types and object oriented programming," I get, "...The relationship ...is that ADTs provide the conceptual blueprint (the "what"), while OOP provides the implementation mechanism (the "how")."

So if the data structure that holds valid information for a CMYK tuple has to be different from an HSL one (and it does) why not just a) conceptualize it as an inheritance relationship and b) implement it using subclassing:

FakeTuple.pm
package FakeTuple;

=head1

Moving away from data structure to Abstract Data Type

=cut

our $VERSION = 0.1;

use constant DEFAXES => 3;

sub new {

my ($self, $tuplelikething, $space_name) = @_;
my $goodTuple = undef;
if ($self->is_tuple($tuplelikething)){
$goodTuple = $tuplelikething;
}
return bless {
space_name => $space_name , #TODO: Validate color space name
tupledata => $goodTuple,
axes => $self->no_of_axes()
};
}

#stuff you should override -- default is CMYK rules

sub no_of_axes {
return DEFAXES;
}

sub is_valid {
my ($self, $data2Check) = @_;
my $result = 0;
for(0..2){$result++ if ($data2Check->[$_]=~m/\d+/ &&
$data2Check->[$_] >= 0 &&
$data2Check->[$_] <= 100)};

return ( $result == $self->no_of_axes() ) ? 1 : 0;
}

# code (loosely) borrowed from Basis.pm

#sub is_tuple { (ref $_[1] eq 'ARRAY' and @{$_[1]} == $_[0]->axis_count) ? 1 : 0 }

sub is_tuple {
my ($self, $tupleref) = @_;
my (@tupledata) = @$tupleref;
(ref $tupledata eq 'ARRAY' and @$tupledata == $self->no_of_axes() and $self->is_valid($tupleref)) ? 1 : 0
}

# Subclass this to make it work for
# a particular color space
sub axis_count { int @{$_[0]{'axis_iterator'}} } # amount of axis

1;



HSLTuple.pm

package HSLTuple;

use lib qw~.~;

use parent qq~FakeTuple~;

#overrides

## no_of_axes() is ok -- like CMYK it is three but they are different

sub is_valid {
my ($self, $data2Check) = @_;
my $result = 0;
if ($data2Check->[0]=~m/\d+/ &&
$data2Check->[0] >= 0 &&
$data2Check->[0] <= 360 ) {++$result }
for(1..2){$result++ if ($data2Check->[$_]=~m/\d+/ &&
$data2Check->[$_] >= 0 &&
$data2Check->[$_] <= 100)};

return ( $result == $self->no_of_axes() ) ? 1 : 0;
}


1;


tupletest.t
use Test::More qw(no_plan); use strict;

use lib qw~.~;

use FakeTuple;

my $prospectTupleRef = [qw~a b c~];

my $tuple = FakeTuple->new($prospectTupleRef, 'CMYK');

ok($tuple->is_valid($prospectTupleRef) == 0, "A B C is an array but not a CYMK tuple");

ok($tuple->is_valid([qw~a b 99~]) == 0 , "A and B are bad, but 99 is good");

ok($tuple->is_valid([qw~a 62 99~]) == 0 , "A is bad");

ok($tuple->is_valid([qw~34 62 99~]) == 1 , "A and B and C are all good for CMYK");

1;

hsltupletest.t
use Test::More qw(no_plan); use strict;

use lib qw~.~;

use HSLTuple;

my $prospectTupleRef = [qw~a b c~];

my $tuple = FakeTuple->new($prospectTupleRef, 'HSL');

ok($tuple->is_valid($prospectTupleRef) == 0, "A B C is an array but not an HSL tuple");

ok($tuple->is_valid([qw~a b 99~]) == 0 , "A and B are bad, but C is good");

ok($tuple->is_valid([qw~a 62 99~]) == 0 , "A is bad");

ok($tuple->is_valid([qw~34 62 99~]) == 1 , "A and B and C are all good for HSL");

ok($tuple->is_valid([qw~361 62 99~]) == 0 , "A must be between 0 and 360 since it is degrees");

ok($tuple->is_valid([qw~360 62 99~]) == 0 , "A is now between 0 and 360 since it is degrees");

1;

The above implementation works the way I like to code which will be different depending on your preferences. For me, I like to create an object with a particular color space type and, if the passed in data is invalid in the constructor, just do not populate its internal data. Normally you would want to die and/or set an error string or raise an error of some kind.

Final note: There was at least one tuple for a color space that had only two values so obviously the code should iterate only the number of times specified in the no_of_axes() method.

Oops, there is no 'edit' here where I could simply post an update but in the previous code there is an error regarding the constructor of FakeTuple that prevents the subclass from working properly. The following is the correction:


FakeTuple.pm
... return bless { space_name => $space_name , #TODO: Validate color space name tupledata => $goodTuple, axes => $self->no_of_axes() }, $self; #customarily variable $class is used

And the test file for the derived class should be modified:


hsltupletest.t ... my $tuple = HSLTuple->new($prospectTupleRef, 'HSL'); ... ok($tuple->is_valid([qw~360 62 99~]) == 1 , "A is now between 0 and 360 since it is degrees");
Base Classes

For years I thought like this too about Perl inheritance but I have seen some examples where a kind of abstract base class was used that simply died if you did not override the methods.

From Google's AI again: "Abstract Base Classes: You can also create an interface by defining a base class where methods simply call die "Method not implemented"."

Here is an actual example from the old Gedafe system. The Pearl.pm base class dies with a message telling you to override the methods.


"...done more elegantly without inheritance...


Before I posted I took some time fishing through the GTC code base. I wondered how easy it would be for me to extend it for a new color space like DCI-P3 for example.

There is actually a native tuple type in Perl. It is used for the instances of classes defined by the new class keyword. Apart from that, the runtime doesn't expose any keywords/operators/etc for creating and manipulating tuples, but you can do so in XS code.

Leave a comment

About lichtkind

user-pic Kephra, Articles, Books, Perl, Programming