Pass the empty subclass test – The Effective Perler

Is your object-oriented module subclassable? Do you know that from testing or are you just guessing? Setting aside other Perl programmers reaching into your package and redefining your subroutines, there are some basic things you can do to ensure that you’ve made life unhard for the people you want to extend your classes.

If you want other people to extend your object-oriented module, you need to ensure that you haven’t done anything that depends on a particular namespace. For instance, if you use the one-argument form of bless, you’re using the current package:

package Cat;

sub new {
	my( $class, $name ) = @_;

	my $hash = {
		name => $name,
		};

	bless $hash;
	}
	
sub get_name { $_[0]->{name} }

In your basic object test, you won’t see a failure, so you won’t notice the problem:

use Test::More;

my $class = 'Cat';
use_ok( $class );
can_ok( $class, 'new' );

my $name = 'Buster';

my $object = $class->new( $name );
isa_ok( $object, $class );

is( $object->get_name, $name, 'The name is the same' );

done_testing();

If your class is subclassable, you should be able to run the same tests on a empty subclass. Create a class that merely inherits from your class, but don’t override or extend anything. There are a variety of ways that you might do this, but merely defining the @ISA:

use Test::More;

my $base  = 'Cat';
my $class = 'Cat::Domestic';
@Cat::Domestic::ISA = ( $base );

use_ok( $base );
can_ok( $class, 'new' );

my $name = 'Buster';

my $object = $class->new( $name );
isa_ok( $object, $class );

is( $object->get_name, $name, 'The name is the same' );

done_testing();

Since you used the two-argument bless, you didn’t create a Cat::Domestic object. You fail the test to check if the object is in the same class that you used to call the constructor, but the rest of the test still works because you haven’t extended anything:

t/base.t ...... ok   
t/subclass.t .. 1/? 
#   Failed test 'The object isa Cat::Domestic'
#   at t/subclass.t line 13.
#     The object isn't a 'Cat::Domestic' it's a 'Cat'
# Looks like you failed 1 test of 5.
t/subclass.t .. Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/5 subtests

There are many cases where you won’t want the object to be the same as the class you used to call the constructor, but I’m going to ignore those sorts of object factories here. If you thought you were getting a Cat::Domestic, you were wrong. If you hadn’t tested with isa_ok, you might think that everything is fine because the object appears to act just like Cat. Of course it does; it’s exactly Cat!

You don’t notice the failure until you try to extend Cat in Cat::Domestic. Suppose you wanted to append Bean to each domestic cat’s name. Since you’re still dealing with a small package, you can simply define the subroutine with the full package specification:

use Test::More;

my $base  = 'Cat';
my $class = 'Cat::Domestic';
@Cat::Domestic::ISA = ( $base );
sub Cat::Domestic::get_name { $_[0]->{name} . ' Bean' }

use_ok( $base );
can_ok( $class, 'new' );

my $name = 'Buster';

my $object = $class->new( $name );
isa_ok( $object, $class );

can_ok( $class, 'get_name' );
is( $object->get_name, "$name Bean", 'The name has a Bean' );

done_testing();

Now your test fails even harder because the name isn’t the value you expect. It doesn’t have the Bean because you never called the Cat::Domestic version:

t/load.t ...... ok   
t/subclass.t .. 1/? 
#   Failed test 'The object isa Cat::Domestic'
#   at t/subclass.t line 14.
#     The object isn't a 'Cat::Domestic' it's a 'Cat'

#   Failed test 'The name has a Bean'
#   at t/subclass.t line 17.
#          got: 'Buster'
#     expected: 'Buster Bean'
# Looks like you failed 2 tests of 5.
t/subclass.t .. Dubious, test returned 2 (wstat 512, 0x200)
Failed 2/4 subtests 

Test Summary Report
-------------------
t/subclass.t (Wstat: 512 Tests: 5 Failed: 2)
  Failed tests:  3, 5
  Non-zero exit status: 2
Files=2, Tests=10,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.03 cusr  0.01 csys =  0.07 CPU)
Result: FAIL
Failed 1/2 test programs. 2/9 subtests failed.
make: *** [test_dynamic] Error 2

Note that you already know what the problem is; you failed the isa_ok test. If you hadn’t included that test, you might go around in circles wondering why Perl isn’t seeing your changes.

The fix is simple: don’t use the two-argument bless. That first argument, $class, is there for a reason. It’s always the invoking class name no matter which class ends up implementing the method:

package Cat;

sub new {
	my( $class, $name ) = @_;

	my $hash = {
		name => $name,
		};

	bless $hash, $class;
	}
	
sub get_name { $_[0]->{name} }

Using the two-argument bless is an accidental failure, but there are other ways to fail. You could explicitly do something to require a particular package name. You might use the two-argument bless but ignore the $class and use __PACKAGE__ instead, or even just used a literal class name:

package Cat;

sub new {
	my( $class, $name ) = @_;

	my $hash = {
		name => $name,
		};

	bless $hash, __PACKAGE__;
	# bless $hash, 'Cat';
	}
	
sub get_name { $_[0]->{name} }

Or, you might think that any subclass should be in the same top-level namespace, so you check for a particular string in the class:

package Cat;
use Carp;

sub new {
	my( $class, $name ) = @_;

	croak "You don't look like a cat!" 
		unless $class =~ / \A Cat :: /;
	
	my $hash = {
		name => $name,
		};

	bless $hash, $class;
	}
	
sub get_name { $_[0]->{name} }

What if your subclass doesn’t use the same top-level namespace? Maybe someone in the DarkPAN wants to pick a name that no one else will use, so he starts it with Local:::

use Test::More;

my $base  = 'Cat';
my $class = 'Local::Cat::Reanimator';
@Local::Cat::Reanimator::ISA = ( $base );

use_ok( $base );
can_ok( $class, 'new' );

my $name = 'Buster';

my $object = $class->new( $name );
isa_ok( $object, $class );

can_ok( $class, 'get_name' );
is( $object->get_name, "$name Bean", 'The name has a Bean' );

done_testing();

This test failure is more dramatic because the the test script croaks right in the middle. It doesn’t get to the end, doesn’t run done_testing(), and confuses the TAP consumer:

t/load.t ...... ok   
t/subclass.t .. 1/? You don't look like a cat! at t/subclass.t line 12
# Tests were run but no plan was declared and done_testing() was not seen.
t/subclass.t .. Dubious, test returned 255 (wstat 65280, 0xff00)
All 2 subtests passed 

Test Summary Report
-------------------
t/subclass.t (Wstat: 65280 Tests: 2 Failed: 0)
  Non-zero exit status: 255
  Parse errors: No plan found in TAP output
Files=2, Tests=9,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.03 cusr  0.01 csys =  0.07 CPU)
Result: FAIL
Failed 1/2 test programs. 0/9 subtests failed.
make: *** [test_dynamic] Error 255

Try something different though. Consider a bit of encapsulation naughtyness. When you create each class, you want to keep a reverse mapping of microchip IDs to cat names. You don’t store this in the object; you use a package variable. However, for some reason, perhaps because it was three in the morning and you’d had two more doses of caffiene than your brain could handle, you wrote some code in get_name_by_microchip that uses a soft reference to access $Microchips based on the class name:

our $Microchips = {};

sub new {
	my( $class, $name, $microchip ) = @_;

	my $hash = {
		name      => $name,
		microchip => $microchip,
		};

	$Microchips->{$microchip} = $name;
	
	bless $hash;
	}
	
sub get_name { $_[0]->{name} }	

sub get_name_by_microchip {
	my( $self, $microchip ) = @_;
	my $class = ref $self;

	no strict 'refs'; # almost always a bad sign
	return unless exists ${"${class}::Microchips"}->{$microchip};
	
	${"${class}::Microchips"}->{$microchip};
	}

That produces the effec that you want as long as you only use Cat. This test passes just fine, so you won’t catch the nastiness with it:

use Test::More;

my $class = 'Cat';
use_ok( $class );
can_ok( $class, 'new' );

my $name      = 'Buster';
my $microchip = '123456';

my $object = $class->new( $name, $microchip );
isa_ok( $object, $class );

can_ok( $class, 'get_name_by_microchip' );
is( $object->get_name_by_microchip( $microchip ), $name, 
	'Found the name by microchip' );

done_testing();

Now try it with the empty subclass:

use Test::More;

my $base  = 'Cat';
my $class = 'Cat::Domestic';
@Cat::Domestic::ISA = ( $base );

use_ok( $base );
can_ok( $class, 'new' );

my $name = 'Buster';
my $microchip = '123456';

my $object = $class->new( $name );
isa_ok( $object, $class );

can_ok( $class, 'get_name_by_microchip' );
is( $object->get_name_by_microchip( $microchip ), $name, 
	'Found the name by microchip' );

done_testing();

This fails because you never find the microchip hash; it’s not in Cat::Domestic:

t/load.t ...... ok   
t/subclass.t .. 1/? 
#   Failed test 'The object isa Cat::Domestic'
#   at t/subclass.t line 14.
#     The object isn't a 'Cat::Domestic' it's a 'Cat'

#   Failed test 'Found the name by microchip'
#   at t/subclass.t line 17.
#          got: undef
#     expected: 'Buster'
# Looks like you failed 2 tests of 5.
t/subclass.t .. Dubious, test returned 2 (wstat 512, 0x200)
Failed 2/5 subtests 

Test Summary Report
-------------------
t/subclass.t (Wstat: 512 Tests: 5 Failed: 2)
  Failed tests:  3, 5
  Non-zero exit status: 2
Files=2, Tests=12,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.03 cusr  0.01 csys =  0.07 CPU)
Result: FAIL
Failed 1/2 test programs. 2/12 subtests failed.
make: *** [test_dynamic] Error 2

Accessing internal variables is already a no-no. You should provide an interface for those so subclasses can do what they need to do.

There are many other ways people make make life harder, and the empty subclass test is not a guarantee that you’ve found all of those problems. You’ll still have to do better testing with subclasses, but don’t skip this test because you think your other subclass tests cover it. Really, it’s simple. You just do the same thing you did in other tests.

Things to remember

Use an empty subclass test to ferret out code that assume a particular package name
Use the two-argument bless
Don’t assume that subclasses can see your internal variables.