| home / programming / awperl2 / 1 |    [previous][next] |
|
|
|
It may seem as though we’re taking ridiculously small steps here. A subroutine that doesn’t do anything? What’s the point in testing for that? Actually, the first time I ran that test, it failed: I had inadvertently gone into overwrite mode in the editor and made a typo in the routine name. The point in testing every little thing is to build your confidence in the code and catch even the dumbest errors right away.
So let’s continue. We should decide on an interface for this module; let’s say that when we tie an array we must specify an upper bound for the array indices, and optionally a lower bound. If the user employs an index out of this range, the program will die. For the sake of having small test files, we’ll create a new one for this test and call it 02tie.t:
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 1;
use blib;
use Tie::Array::Bounded;
my $obj = tie my @array, "Tie::Array::Bounded";
isa_ok($obj, "Tie::Array::Bounded");
So far, this just tests that the underlying object from the tie
is or inherits from Tie::Array::Bounded. Run this test before you even
add any code to TIEARRAY to make sure that it does indeed fail:
% ./02tie.t
1..1
Using /home/peter/perl_Medic/Tie/Array/Bounded/t/../blib
not ok 1 - The object isa Tie::Array::Bounded # Failed
test (./02tie.t at line 10)
# The object isn't defined
# Looks like you failed 1 tests of 1.
We’re not checking that the module can be used or that it has a TIEARRAY
method; we already did those things in 01load.t. Now we know that the test routine
is working properly. Let’s make a near-minimal version of TIEARRAY
that will satisfy this test:
sub TIEARRAY
{
my $class = shift;
my ($upper, $lower);
return bless { upper => $upper,
lower => $lower,
array => []
}, $class;
}
Now the test passes. Should we test that the object is a hashref with keys
upper, lower, and so on? No—that’s part of the private
implementation of the object and users, including tests, have no right peeking
in there.
Well, it doesn’t really do to have a bounded array type if the user doesn’t specify any bounds. A default lower bound of 0 is obvious because most bounded arrays will start from there anyway and be limited in how many elements they can contain. It doesn’t make sense to have a default upper bound because no guess could be better than any other. We want this module to die if the user doesn’t specify an upper bound (italicized code):
sub TIEARRAY
{
my ($class, %arg) = @_;
my ($upper, $lower) = @arg{qw(upper lower)};
$lower ||= 0;
croak "No upper bound for array" unless $upper;
return bless { upper => $upper,
lower => $lower,
array => []
}, $class;
}
Note that when we want to die in a module, the proper routine to use is croak().
This results in an error message that identifies the calling line of the code,
and not the current line, as the source of the error. This allows the user to
locate the place in their program where they made a mistake. croak() comes from
the Carp Module, so we added a use Carp statement to Bounded.pm (not shown).
Note also that we set the lower bound to a default of 0. True, if the user
didn’t specify a lower bound, $lower would be undefined and hence evaluate
to 0 in a numeric context. But it’s wise to expose our defaults explicitly,
and this also avoids warnings about using an uninitialized value. Modify 02tie.t
to say:
use Test::More tests => 1; use
Test::Exception; use blib;
use Tie::Array::Bounded;
dies_ok { tie my @array, "Tie::Array::Bounded"
"Croak with no bound specified";
If you’re running 02tie.t as a stand-alone test, remember
to run make in the parent directory after modifying
Bounded.pm so that Bounded.pm gets copied
into the blib
tree.
Great! Now let’s add back in the test that we can create a real object
when we tie with the proper calling sequence:
my $obj;
lives_ok { $obj = tie my @array, "Tie::Array::Bounded",
upper => 42
} "Tied array okay";
isa_ok($obj, "Tie::Array::Bounded");
and increase the number of tests to 3. (Notice that there is no comma after
the block of code that’s the first argument to dies_ok and
lives_ok.)
All this testing has gotten us in a pedantic frame of mind. The user shouldn’t
be allowed to specify an array bound that is negative or not an integer. Let’s
add a statement to TIEARRAY (in italics):
sub TIEARRAY {
my ($class, %arg) = @_;
my ($upper, $lower) = @arg{qw(upper lower)}; $lower ||= 0;
croak "No upper bound for array" unless $upper; /\D/ and
croak "Array bound must be integer"
for ($upper, $lower);
return bless { upper => $upper,
lower => $lower,
array => []
}, $class;
qr/must be integer/, "Non-integral bound fails";
Now we’re not only checking that the code dies, but that it dies with a message
}
and of course, test it:
throws_ok { tie my@array, "Tie::Array::Bounded", upper => -1 }
matching a particular pattern.
We’re really on a roll here! Why don’t we batten down the hatches on this interface and let the user know if they gave us an argument we’re not expecting:
sub TIEARRAY
{
my ($class, %arg) = @_;
my ($upper, $lower) = delete @arg{qw(upper lower)} croak "Illegal arguments
in tie" if %arg; croak "No upper bound for array" unless $upper;
$lower ||= 0;
/\D/ and croak "Array bound must be integer"
for ($upper, $lower);
return bless
{ upper => $upper,
lower => $lower,
array => [] }, $class;
}
and the test:
throws_ok { tie my @array, "Tie::Array::Bounded", frogs =>
10 } qr/Illegal arguments/, "Illegal
argument fails";
The succinctness of our approach depends on the underappreciated hash slice
and the delete() function. Hash slices [GUTTMAN98] are a way to
get multiple elements from a hash with a single expression, and the delete()
function removes those elements while returning their values. Therefore, anything
left in the hash must be illegal.
| home / programming / awperl2 / 1 | [previous][next] |
Jupitermedia Corporation has two divisions: Jupiterimages and JupiterOnlineMedia
Legal Notices, Licensing, Reprints, Permissions, Privacy Policy.
Advertise | Newsletters | Tech Jobs | Shopping | E-mail Offers
Created: March 27, 2003
Revised: March 24, 2004
URL: http://webreference.com/programming/awperl2/1
