Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

ait's scratchpad

by ait (Friar)
on Aug 25, 2005 at 17:51 UTC ( #486669=scratchpad: print w/ replies, xml ) Need Help??

This is a proposal for a Tutorial. Please post your comments here RFC: Tutorial "Introspecting your Moose code using Test Point Callbacks"

Introspecting your Moose code using Test Point Callbacks

There are times when you want to check the value of something at a specific place in your object code, much like the times when you wind up setting up a debugger's break point and watches. This technique allows you to set-up automated "Test Points" analogous to those found in printed circuit boards. This way, you can test for example: partial results within a sub, monitor some local var or object attribute in a sub, or check the HTTP status of an LWP call to another system (i.e. to SKIP certain tests given the result of this call).

How it works

You set-up a single test_callback attribute in your Moose object which will be initialized with a simple sub that does nothing. Then, whenever you find yourself in the need to debug something instead of using a warn statement that you will throw away, or whenever you have found the need for a DB breakpoint and watches, you can just as easily code a permanent test point, helping you debug this problem in the future using diags and test result messages rather than warns all over the place.

Here is a simple test class and test code that illustrates this technique:

test_class.pm

package test_class; use Moose; has 'foo' => ( is => 'rw', isa => 'Str', ); has 'bar' => ( is => 'rw', isa => 'Str', ); has 'test_callback' => ( is => 'rw', isa => 'CodeRef', ); sub BUILD { my $self = shift; # initialize the test callback $self->test_callback(sub {return;}); } sub asub { my $self = shift; my $lvar_foo; my $lvar_bar; # some code that sets bar $self->bar('result'); # you want to test the value of bar at this point $self->test_callback->('test_point_one'); # some code that sets a local vars $lvar_foo = 'yuca'; $lvar_bar = 'pelada'; # you want to test the value of lvar at this point $self->test_callback->('test_point_two', { lvar_foo => $lvar_foo, lvar_bar => $lvar_bar, }); return 1; } __PACKAGE__->meta->make_immutable; 1;

test_class.t

#!/usr/bin/perl use strict; use warnings; use Test::More; BEGIN { use_ok 'test_class' } my $tc = test_class->new(); # the dispatch table my %test_points = ( test_point_one => \&test_point_one, test_point_two => \&test_point_two, ); # setup the callback dispatch $tc->test_callback( sub { my $tp = shift; $test_points{$tp}->(@_); } ); # regular tests here cmp_ok($tc->asub(), '==', 1, 'Result of asub'); # callback test subs here (or in pm?) sub test_point_one { my $params = shift; #not used in this test point cmp_ok($tc->bar, 'eq', 'result', 'Value of attr bar at test_point_one'); } sub test_point_two { my $params = shift; cmp_ok($params->{lvar_foo}, 'eq', 'yuca', 'Value of lvar_foo at test_point_two'); cmp_ok($params->{lvar_bar}, 'eq', 'pelada', 'Value of lvar_bar at test_point_two'); } done_testing();
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (11)
As of 2014-08-28 23:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (275 votes), past polls