Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic

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:

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;


#!/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?

What's my password?
Create A New User
choroba waves
[Mj1234]: Hello Monks, I have installed Active perl 5.16 and 5.14 but I dont find Devel::GDB package when I try to install through ppm
[Discipulus]: i'v installed ubuntu 16.04lts and i'm quite disappointed: is deadly simmilar to new win osses where you cannot find even simple things...
[Corion]: Hi Discipulus ;)
[Corion]: Mj1234: Maybe Ubuntu didn't package Devel::GDB? In that case, consider using local::lib and install the module from CPAN
[Corion]: But a quick Google search turns up this page, which seems to suggest that it should be packaged
[Discipulus]: iirc active perl has repositories only for last 2 o 3 major release of perl Mj1234. I strongly suggest portable version of strawberry perl and use cpan client to install modules
[choroba]: Also, who needs GDB when there's hdb?

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2016-12-07 08:53 GMT
Find Nodes?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:

    Results (125 votes). Check out past polls.