| Plenty of useful modules do their work procedurally, without the modularity of functions and objects. Many modules, written before object orientation became popular, use package variables to control their behavior. To test your code fully, sometimes you have to reach inside those packages to change their variables . Tread lightly, though. Tricky testing code is harder to write and harder to debug. How do I do that? Suppose that you have a simple logging package. Its single subroutine, log_message( ) , takes a message and logs it to a filehandle. It also adds a time and date stamp to the start of the message and information about the function's caller to the end, if two package global variables, $REPORT_TIME and $REPORT_CALLER , are true. Save the following code to lib/Logger.pm : package Logger; use strict; our $OUTPUT_FH = *STDERR; our $REPORT_TIME = 1; our $REPORT_CALLER = 1; sub log_message { my ($package, $file, $line) = caller( ); my $time = localtime( ); my $message = ''; $message .= "[$time] " if $REPORT_TIME; $message .= shift; $message .= " from $package:$line in $file" if $REPORT_CALLER; $message .= "\n"; write_message( $message ); } sub write_message { my $message = shift; print $OUTPUT_FH $message; } 1;
Fortunately, the module is simple enough, so it's straightforward to test. The difficult part is figuring out how to capture the output from write_message( ) . You could test both functions at the same time, but it's easier to test features in isolation, both to improve your test robustness and to reduce complications. Save the following code to log_message.t : #!perl use strict; use warnings; use lib 'lib'; use Test::More tests => 6; use Test::MockModule; my $module = 'Logger'; use_ok( $module ) or exit; can_ok( $module, 'log_message' ); { local $Logger::REPORT_TIME = 0; local $Logger::REPORT_CALLER = 0; my $message; my $logger = Test::MockModule->new( 'Logger' ); $logger->mock( write_message => sub { $message = shift } ); Logger::log_message( 'no decoration' ); is( $message, "no decoration\n", 'log_message( ) should not add time or caller unless requested' ); $Logger::REPORT_TIME = 1; Logger::log_message( 'time only' ); (my $time = localtime( )) =~ s/:\d+ /:\d+ /; like( $message, qr/^\[$time\] time only$/, '... adding time if requested' ); $Logger::REPORT_CALLER = 1; my $line = _ _LINE_ _ + 1; Logger::log_message( 'time and caller' ); like( $message, qr/^\[$time\] time and caller from main:$line in #!perl use strict; use warnings; use lib 'lib'; use Test::More tests => 6; use Test::MockModule; my $module = 'Logger'; use_ok( $module ) or exit; can_ok( $module, 'log_message' ); { local $Logger::REPORT_TIME = 0; local $Logger::REPORT_CALLER = 0; my $message; my $logger = Test::MockModule->new( 'Logger' ); $logger->mock( write_message => sub { $message = shift } ); Logger::log_message( 'no decoration' ); is( $message, "no decoration\n", 'log_message( ) should not add time or caller unless requested' ); $Logger::REPORT_TIME = 1; Logger::log_message( 'time only' ); (my $time = localtime( )) =~ s/:\d+ /:\\d+ /; like( $message, qr/^\[$time\] time only$/, '... adding time if requested' ); $Logger::REPORT_CALLER = 1; my $line = _ _LINE_ _ + 1; Logger::log_message( 'time and caller' ); like( $message, qr/^\[$time\] time and caller from main:$line in $0$/, '... adding time and caller, if both requested' ); $Logger::REPORT_TIME = 0; $line = _ _LINE_ _ + 1; Logger::log_message( 'caller only' ); like( $message, qr/^caller only from main:$line in $0$/, '... adding caller only if requested ' ); } $/, '... adding time and caller, if both requested' ); $Logger::REPORT_TIME = 0; $line = _ _LINE_ _ + 1; Logger::log_message( 'caller only' ); like( $message, qr/^caller only from main:$line in #!perl use strict; use warnings; use lib 'lib'; use Test::More tests => 6; use Test::MockModule; my $module = 'Logger'; use_ok( $module ) or exit; can_ok( $module, 'log_message' ); { local $Logger::REPORT_TIME = 0; local $Logger::REPORT_CALLER = 0; my $message; my $logger = Test::MockModule->new( 'Logger' ); $logger->mock( write_message => sub { $message = shift } ); Logger::log_message( 'no decoration' ); is( $message, "no decoration\n", 'log_message( ) should not add time or caller unless requested' ); $Logger::REPORT_TIME = 1; Logger::log_message( 'time only' ); (my $time = localtime( )) =~ s/:\d+ /:\\d+ /; like( $message, qr/^\[$time\] time only$/, '... adding time if requested' ); $Logger::REPORT_CALLER = 1; my $line = _ _LINE_ _ + 1; Logger::log_message( 'time and caller' ); like( $message, qr/^\[$time\] time and caller from main:$line in $0$/, '... adding time and caller, if both requested' ); $Logger::REPORT_TIME = 0; $line = _ _LINE_ _ + 1; Logger::log_message( 'caller only' ); like( $message, qr/^caller only from main:$line in $0$/, '... adding caller only if requested ' ); } $/, '... adding caller only if requested' ); }
Run it with prove : $ prove log_message.t log_message....ok All tests successful. Files=1, Tests=6, 0 wallclock secs ( 0.10 cusr + 0.00 csys = 0.10 CPU)
What just happened ? The first interesting section of code, in the block following can_ok( ) , localizes the two package variables from Logger , $REPORT_TIME and $REPORT_CALLER .
Note: See "Temporary Values via local( )" in perldoc perlsub for more details on localizing global symbols. This is a big topic related to Perl's inner workings .
The benefit of local( ) is that it allows temporary values for global symbols, even those from other packages. Outside of that scope, the variables retain their previous values. Though it's easy to assign to them without localizing them, it's nicer to encapsulate those changes in a new scope and let Perl restore their old values. Inside the scope of the local ized variables, the test uses Test::MockModule 's mock( ) method to install a temporary write_message( ) only for the duration of the lexical scope. With the new write_message( ) temporarily in place, the message that log_message( ) creates will end up in the $message variable, which makes it easy to test the four possible combinations of reporting values. The rest of the code is straightforward, with two exceptions. Note how the regular expression changes the output of localtime( ) to make the test less sensitive about timing issues; the test shouldn't fail if it happens to run just at the boundary of a second. As it is, there is still a small race condition if the minute happens to turn over, but the potential for failure is much smaller now. The other new piece is the use of the _ _LINE_ _ directive and the special variable $0 to verify that log_message( ) reports the proper calling line number and filename. What about... | Q: | What's the best way to test write_message( ) ? | | A: | write_message( ) performs two different potential actions. First, it writes to the STDERR filehandle by default. Second, it writes to the filehandle in $OUTPUT_FH if someone has set it. The Test::Output module from the CPAN is useful for both tests. Save the following code to write_message.t : #!perl use strict; use warnings; use lib 'lib'; use Test::More tests => 3; use Test::Output; use Test::Output::Tie; my $module = 'Logger'; use_ok( $module ) or exit; stderr_is( sub { Logger::write_message( 'To STDERR!' ) }, 'To STDERR!', 'write_message( ) should write to STDERR by default' ); { local *Logger::OUTPUT_FH; my $out = tie *Logger::OUTPUT_FH, 'Test::Output::Tie'; $Logger::OUTPUT_FH = *Logger::OUTPUT_FH; Logger::write_message( 'To $out!' ); is( $out->read( ), 'To $out!', '... or to $OUTPUT_FH, if set' ); }
Run it with prove : $ prove write_message.t write_message....ok All tests successful. Files=1, Tests=3, 0 wallclock secs ( 0.11 cusr + 0.00 csys = 0.11 CPU)
Test::Output 's stderr_is( ) is handy for testing Logger 's default behavior. Its only quirk is that its first argument must be an anonymous subroutine. Otherwise, it's as simple as can be. Testing that write_message( ) prints to other filehandles is only slightly more complex. As with the tests for write_message( ) , the goal is to capture the output in a variable. Test::Output uses a module called Test::Output::Tie internally to do exactly that. It ties a filehandle that captures all data printed to it and returns this data when you call its read( ) method.
Note: Tying a variable with tie( ) is like subclassing a module; it presents the same interface but performs different behavior. See perldoc perltie to learn more .
| |
