Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
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 meditating upon the Monastery: (11)
As of 2014-10-23 14:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (125 votes), past polls