Testing Code and Assuring Quality

0 %
100 %
Information about Testing Code and Assuring Quality

Published on December 6, 2007

Author: kcowgill

Source: slideshare.net

Description

Learning to use Test::More,
Perl::Critic, and Devel::Cover

Testing Code and Assuring Quality Learning to use Test::More, Perl::Critic, and Devel::Cover Kent Cowgill

Testing Code and Assuring Quality •Learn how to write unit tests in perl •Write tests for your code •Ensuring your code is high quality •Ensuring your tests fully exercise your code •Writing functional tests for your code •A practical example of creating a test suite •How to save time and effort (be lazy!)

What is testing?

Testing. Software testing is the process used to help identify the correctness, completeness, security, and quality of developed computer software. Testing is a process of technical investigation, performed on behalf of stakeholders, that is intended to reveal quality-related information about the product with respect to the context in which it is intended to operate. This includes, but is not limited to, the process of executing a program or application with the intent of finding errors. Quality is not an absolute; it is value to some person. With that in mind, testing can never completely establish the correctness of arbitrary computer software; testing furnishes a criticism or comparison that compares the state and behavior of the product against a specification. -- excerpted from http://en.wikipedia.org/wiki/Software_testing

Testing.. In software engineering, a test case is a set of conditions or variables under which a tester will determine if a requirement upon an application is partially or fully satisfied. It may take many test cases to determine that a requirement is fully satisfied. In order to fully test that all the requirements of an application are met, there must be at least one test case for each requirement unless a requirement has sub requirements. Some methodologies recommend creating at least two test cases for each requirement. One of them should perform positive testing of requirement and other should perform negative testing. -- excerpted from http://en.wikipedia.org/wiki/Test_Case

Testing... What characterizes a formal, written test case is that there is a known input and an expected output, which is worked out before the test is executed. If the application is created without formal requirements, then test cases are written based on the accepted normal operation of programs of a similar class. -- excerpted from http://en.wikipedia.org/wiki/Test_Case

How can I find out more information about testing with Perl?

(or anything else you talk about tonight, since you don't really cover anything in great depth?) (yeah, sorry about that)

Google

Websites

1 CPAN

2 CPAN

Screencast demonstration removed for PDF

Books

How to write unit tests in Perl

Unit tests emit TAP

Test Anything Protocol (TAP) • The Test Anything Protocol is a general purpose format for transmitting the result of test programs to a thing which interprets and takes action on those results.

Test Anything Protocol (TAP) 1..N ok 1 Description # Directive # Diagnostic .... ok 47 Description ok 48 Description more tests....

Test Anything Protocol (TAP) 1..4 ok 1 - Input file opened not ok 2 - First line of the input valid ok 3 - Read the rest of the file not ok 4 - Summarized correctly # TODO

Let's write some tests.

Test::Simple • ok( <expression>, <description>); ok( $num == 30, '$num equals 30' ); ok( $this =~ m/that/, 'this matches that' ); ok( do_it( $param ), 'sub do_it() returns true' ); OUTPUT: ok 1 - $num equals 30 ok 2 - this matches that ok 3 - sub do_it() returns true

Test::Simple • ok( <expression>, <description>); ok( $num == 30, '$num equals 30' ); ok( $this =~ m/that/, 'this matches that' ); ok( do_it( $param ), 'sub do_it() returns true' ); OUTPUT: not ok 1 - $num equals 30 # Failed test '$num equals 30' # in test.pl at line 10.

Test::Simple • ok( <expression>, <description>); ok( $num == 30, '$num equals 30' ); ok( $this =~ m/that/, 'this matches that' ); ok( do_it( $param ), 'sub do_it() returns true' ); OUTPUT: not ok 2 - this matches that # Failed test 'this matches that' # in test.pl at line 11.

Test::Simple • ok( <expression>, <description>); ok( $num == 30, '$num equals 30' ); ok( $this =~ m/that/, 'this matches that' ); ok( do_it( $param ), 'sub do_it() returns true' ); OUTPUT: not ok 3 - sub do_it() returns true # Failed test 'sub do_it() returns true' # in test.pl at line 13.

Test::More • is( <got>, <expected>, <description>); is( $this, $that, 'this is the same as that' );

Test::More • is( <got>, <expected>, <description>); is( $this, $that, 'this is the same as that' ); OUTPUT: ok 1 - this is the same as that

Test::More • is( <got>, <expected>, <description>); is( $this, $that, 'this is the same as that' ); OUTPUT: not ok 1 - this is the same as that # Failed test 'this is equal to that' # in test.t at line 10 # got: 'this' # expected: 'that'

Actual URL: http://pub.langworth.com/perl_test_refcard.pdf

Introducing Prove PROVE(1) User Contributed Perl Documentation PROVE(1) NAME prove -- A command-line tool for running tests OPTIONS -d, --debug Includes extra debugging information -h, --help Display this help -H, --man Longer manpage for prove -I Add libraries to @INC, as Perl's -I -l, --lib Add lib to the path for your tests -r, --recurse Recursively descend into directories -s, --shuffle Run the tests in a random order --timer Print elapsed time after each test file -v, --verbose Display standard output of test scripts while running ...

Output: $ mv testmore.pl testmore.t $ prove ./testmore....ok All tests successful. Files=1, Tests=3, 0 wallclock secs ( 0.02 cusr + 0.01 csys = 0.03 CPU) $ prove -v ./testmore....ok 1 - this should equal thistoo ok 2 - this should be thistoo (is) ok 3 - this should NOT be that (isnt) 1..3 ok All tests successful. Files=1, Tests=3, 0 wallclock secs ( 0.02 cusr + 0.01 csys = 0.03 CPU)

How Many Tests? #!/usr/bin/perl use strict; use warnings; use Test::More tests => 3; # set some testing variables my $this = quot;thisquot;; my $thistoo = quot;thisquot;; my $that = quot;thatquot;; # now for the tests ok( $this eq $thistoo, quot;this should equal thistooquot; ); is( $this, $thistoo, quot;this should be thistoo (is)quot; ); isnt( $this, $that, quot;this should NOT be that (isnt)quot; );

How Many Tests? $ prove -v ./testmore....1..3 ok 1 - this should equal thistoo ok 2 - this should be thistoo (is) ok 3 - this should NOT be that (isnt) ok All tests successful. Files=1, Tests=3, 0 wallclock secs ( 0.02 cusr + 0.01 csys = 0.03 CPU)

How Many Tests? #!/usr/bin/perl use strict; use warnings; use Test::More tests => 4; # set some testing variables my $this = quot;thisquot;; my $thistoo = quot;thisquot;; my $that = quot;thatquot;; # now for the tests ok( $this eq $thistoo, quot;this should equal thistooquot; ); is( $this, $thistoo, quot;this should be thistoo (is)quot; ); isnt( $this, $that, quot;this should NOT be that (isnt)quot; );

How Many Tests? $ prove -v testmore....1..4 ok 1 - this equals thistoo ok 2 - another way to see if this and thistoo are equal # Looks like you planned 4 tests but only ran 3. ok 3 - a way to see if this and that are not equal dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 4 Failed 1/4 tests, 75.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------- testmore.t 255 65280 4 24 Failed 1/1 test scripts. 1/4 subtests failed. Files=1, Tests=4, 0 wallclock secs ( 0.02 cusr + 0.01 csys = 0.03 CPU) Failed 1/1 test programs. 1/4 subtests failed.

Why prove, anyhow?

-l, --lib Add lib to the path for your tests

-l, --lib Add lib to the path for your tests -r, --recurse Recursively descend into directories

-l, --lib Add lib to the path for your tests -r, --recurse Recursively descend into directories -s, --shuffle Run the tests in a random order

That's great

but...

how does that help me? :-/

perl -c

Your problem:

Your code compiles, but does it do the right thing?

Does it? I mean, REALLY?

How do you know?

Can you prove it?

My problem: ZFML* * Name changed to protect the innocent

(btw, what the heck is ZFML?)

ZFML is a custom template system

ZFML is a mish-mash of HTML and Perl

ZFML only exists at AcmeCorp.com* * Name changed to protect the innocent

I don't think you'd want it to exist anywhere else.

SRSLY

ZFML That looks <html> <head><title></title></head> like HTML <body> </body> </html> <!-- __INIT SETUP__ my ($p) = @_; $p->var->{'ONLOAD'} .= q(agentDOMCheck();); $p->var->{'SCRIPT'} .= q(<script src=quot;form_functions.jsquot;></script>); --> <!-- __EVAL COPYRIGHT_YEAR__ my ($p) = @_; $p->var->{'COPYRIGHT_YEAR'} = 1900 + (localtime)[5]; -->

ZFML That looks <html> <head><title></title></head> like HTML <body> </body> </html> <!-- __INIT SETUP__ WTF?!? my ($p) = @_; $p->var->{'ONLOAD'} .= q(agentDOMCheck();); $p->var->{'SCRIPT'} .= q(<script src=quot;form_functions.jsquot;></script>); --> <!-- __EVAL COPYRIGHT_YEAR__ my ($p) = @_; $p->var->{'COPYRIGHT_YEAR'} = 1900 + (localtime)[5]; -->

It only runs under mod_perl

:(

$ perl -c index.zfml Bareword found where operator expected at index.zfml line 5, near quot;<meta http-equiv=quot;content-typequot; content=quot;text/htmlquot; (Might be a runaway multi-line // string starting on line4) (Missing operator before html?) String found where operator expected at index.zfml line 6, near quot;<meta name=quot;quot; (Might be a runaway multi-line quot;quot; string starting on line 5) (Missing semicolon on previous line?) Bareword found where operator expected at index.zfml line 6, near quot;<meta name=quot;descriptionquot; (Missing operator before description?) String found where operator expected at index.zfml line 6, near quot;descriptionquot; content=quot;quot; Bareword found where operator expected at index.zfml line 6, near quot;quot; content=quot;Findquot; (Missing operator before Find?) Bareword found where operator expected at index.zfml line 7, near quot;<meta NAME=quot;keywordsquot; (Might be a runaway multi-line quot;quot; string starting on line 6) (Missing operator before keywords?) String found where operator expected at index.zfml line 7, near quot;keywordsquot; CONTENT=quot;quot; Bareword found where operator expected at index.zfml line 7, near quot;quot; CONTENT=quot;AcmeCorpquot; (Missing operator before AcmeCorp?) Bareword found where operator expected at index.zfml line 7, near quot;time jobsquot; (Do you need to predeclare time?) String found where operator expected at index.zfml line 8, near quot;<style type=quot;quot; (Might be a runaway multi-line quot;quot; string starting on line 7) (Missing semicolon on previous line?) Bareword found where operator expected at index.zfml line 8, near quot;<style type=quot;textquot; (Missing operator before text?) String found where operator expected at index.zfml line 28, near quot;<div id=quot;quot; (Might be a runaway multi-line quot;quot; string starting on line 8) (Missing semicolon on previous line?) Bareword found where operator expected at index.zfml line 28, near quot;<div id=quot;pageContainerquot; (Missing operator before pageContainer?)

Write tests for your code

A Simple Class #!/usr/bin/perl use strict; use warnings; package myObj; sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name } || 'default'; return bless $self, $class; } sub set_name { my $self = shift; $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

A Simple Class #!/usr/bin/perl use strict; use warnings; Constructor package myObj; (http://en.wikipedia.org/wiki/Constructor_%28computer_science%29) sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name } || 'default'; return bless $self, $class; } sub set_name { my $self = shift; $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

A Simple Class #!/usr/bin/perl use strict; use warnings; Constructor package myObj; (http://en.wikipedia.org/wiki/Constructor_%28computer_science%29) sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name } || 'default'; return bless $self, $class; } Mutator sub set_name { my $self = shift; (http://en.wikipedia.org/wiki/Mutator_method) $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

A Simple Class #!/usr/bin/perl use strict; use warnings; Constructor package myObj; (http://en.wikipedia.org/wiki/Constructor_%28computer_science%29) sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name } || 'default'; return bless $self, $class; } Mutator sub set_name { my $self = shift; (http://en.wikipedia.org/wiki/Mutator_method) $self->{ name } = shift; } sub get_name { Accessor my $self = shift; return $self->{ name }; (http://en.wikipedia.org/wiki/Accessor) } 1;

Using A Simple Class #!/usr/bin/perl use strict; use warnings; use myObj; ...

Using A Simple Class #!/usr/bin/perl use strict; Calling the use warnings; Constructor use myObj; my $obj = myObj->new( name => 'My Object' ); ...

Using A Simple Class #!/usr/bin/perl use strict; Calling the use warnings; Constructor use myObj; my $obj = myObj->new( name => 'My Object' ); my $objName = $obj->get_name(); ... Calling the Accessor

Using A Simple Class #!/usr/bin/perl use strict; Calling the use warnings; Constructor use myObj; my $obj = myObj->new( name => 'My Object' ); my $objName = $obj->get_name(); my $new_name = 'Your Object' ); Calling the Accessor $obj->set_name( $new_name ); Calling the Mutator

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More

Testing A Simple Class #!/usr/bin/perl It's fine to start use strict; use warnings; out without a use Test::More 'no_plan'; testing plan (number of tests to run)

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; Make sure you can use Test::More 'no_plan'; quot;usequot; the BEGIN { use_ok( 'myObj' ); } object

Testing A Simple Class #!/usr/bin/perl use strict; Make sure you use warnings; can instantiate use Test::More 'no_plan'; the object (call BEGIN { use_ok( 'myObj' ); } the constructor) ok( my $obj1 = myObj->new( name => 'test1' ), quot;can create a myObj specifying valuesquot; );

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); } Make sure your ok( my $obj1 = myObj->new( name => 'test1' ), ); instantiated quot;can create a myObj specifying valuesquot; isa_ok( $obj1, 'myObj' ); object quot;isaquot; type of object you created

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); Instantiate another object

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); Make sure the isa_ok( $obj2, 'myObj' ); new object quot;isaquot; quot;myObjquot; object

Testing A Simple Class Test using the #!/usr/bin/perl mutator of the use strict; use warnings; name property of use Test::More 'no_plan'; the object BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), quot;can set namequot; );

Testing A Simple Class #!/usr/bin/perl Make sure the use strict; accessor returns use warnings; the value we just use Test::More 'no_plan'; set BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), quot;can set namequot; ); ok( 'test1' eq $obj2->get_name(), quot;can get namequot; );

Testing A Simple Class #!/usr/bin/perl Perform a quot;deepquot; use strict; comparison of use warnings; the two objects use Test::More 'no_plan'; (created in BEGIN { use_ok( 'myObj' ); } ), different ways) ok( my $obj1 = myObj->new( name => 'test1' quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), quot;can set namequot; ); ok( 'test1' eq $obj2->get_name(), quot;can get namequot; ); is_deeply( $obj1, $obj2, quot;obj1 seems deeply similar to obj2quot; );

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; Specify the use Test::More tests => 8; number of tests we intend to run BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), quot;can set namequot; ); ok( 'test1' eq $obj2->get_name(), quot;can get namequot; ); is_deeply( $obj1, $obj2, quot;obj1 seems deeply similar to obj2quot; );

Testing A Simple Class Output: $ prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 0 wallclock secs ( 0.02 cusr + 0.01 csys = 0.03 CPU)

That's great

but...

how does that help me? :-|

Testing Zfml $ cat testindex.t ... BEGIN { use_ok( 'index.zfml' ) }; ... $ prove testindex.t testindex.... # Failed test 'use index.zfml;' # in testindex.t at line 8. # Tried to use 'index.zfml'. # Error: syntax error at (eval 3) line 2, near quot;use index.quot; # Looks like you failed 1 test of 1. testindex....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 1 Failed 1/1 tests, 0.00% okay Failed Test Stat Wstat Total Fail List of Failed --------------------------------------------------------------------- testindex.t 1 256 1 11 Failed 1/1 test scripts. 1/1 subtests failed. Files=1, Tests=1, 0 wallclock secs ( 0.03 cusr + 0.01 csys = 0.04 CPU) Failed 1/1 test programs. 1/1 subtests failed.

Ensuring your code is high* quality**

* for some values of high

** for some values of quality

Introducing Perl::Critic and perlcritic Perl::Critic(3) User Contributed Perl Documentation Perl::Critic(3) NAME Perl::Critic - Critique Perl source code for best-practices SYNOPSIS use Perl::Critic; my $file = shift; my $critic = Perl::Critic->new(); my @violations = $critic->critique($file); print @violations; DESCRIPTION Perl::Critic is an extensible framework for creating and applying coding standards to Perl source code. Essentially, it is a static source code analysis engine. Perl::Critic is distributed with a number of Perl::Critic::Policy modules that attempt to enforce various coding guidelines. Most Policy modules are based on Damian Conway's book Perl Best Practices.

Introducing Perl::Critic and perlcritic PERLCRITIC(1) User Contributed Perl Documentation PERLCRITIC(1) NAME quot;perlcriticquot; - Command-line interface to critique Perl source SYNOPSIS perlcritic [-12345 | -severity number] [-noprofile | -profile file] [-top [ number ]] [-include pattern] [-exclude pattern] [-theme expression] [-verbose number | format] [-list] [-only | -noonly] [-force | -noforce] [-nocolor] [-Version] [-help] [-man] [-quiet] [FILE | DIRECTORY | STDIN] DESCRIPTION quot;perlcriticquot; is a Perl source code analyzer. It is the executable front-end to the Perl::Critic engine, which attempts to identify awkward, hard to read, error-prone, or unconventional constructs in your code. Most of the rules are based on Damian Conway's book Perl Best Practices.

Don't worry, it's all in perldoc.

Working with perlcritic $ perlcritic -1 myObj.pm RCS keywords $Id$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $HeadURL$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $Source$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) No quot;VERSIONquot; variable found at line 1, column 1. See page 404 of PBP. (Severity: 2) Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with quot;returnquot; at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with perlcritic $ perlcritic -1 myObj.pm RCS keywords $Id$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $HeadURL$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $Source$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) No quot;VERSIONquot; variable found at line 1, column 1. See page 404 of PBP. (Severity: 2) Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with quot;returnquot; at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with .perlcriticrc $ cat .perlcriticrc [-Miscellanea::RequireRcsKeywords] [-Modules::RequireVersionVar]

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with quot;returnquot; at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with quot;returnquot; at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with perlcritic sub set_name { my $self = shift; $self->{ name } = shift; return; }

Working with perlcritic Output: $ prove -v testobj.t testobject....1..8 # Failed test 'can set name' # in testobject.t at line 17. # Looks like you failed 1 test of 8. ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj not ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 Files=1, Tests=8, 0 wallclock secs ( 0.03 cusr + 0.01 csys = 0.04 CPU) Failed 1/1 test programs. 1/8 subtests failed.

Working with perlcritic #!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), The mutator quot;can create a myObj specifying valuesquot; ); isa_ok( $obj1, 'myObj' ); shouldn't return a value! ok( my $obj2 = myObj->new(), quot;can create a myObj not specifying valuesquot; ); isa_ok( $obj2, 'myObj' ); ok( ! $obj2->set_name( 'test1' ), quot;can set namequot; ); ok( 'test1' eq $obj2->get_name(), quot;can get namequot; ); is_deeply( $obj1, $obj2, quot;obj1 seems deeply similar to obj2quot; );

Working with perlcritic Output: $ prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 0 wallclock secs ( 0.02 cusr + 0.01 csys = 0.03 CPU)

Perl::Critic and Zfml $ perlcritic -1 index.zfml Code not contained in explicit package at line 1, column 1. Violates encapsulation. (Severity: 4) Code before strictures are enabled at line 1, column 1. See page 429 of PBP. (Severity: 5) Code before warnings are enabled at line 1, column 1. See page 431 of PBP. (Severity: 4) Mixed high and low-precedence booleans at line 1, column 1. See page 70 of PBP. (Severity: 4) Useless interpolation of literal string at line 1, column 23. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 1, column 64. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 2, column 13. See page 51 of PBP. (Severity: 1) Hard tabs used at line 4, column 60. See page 20 of PBP. (Severity: 3) Code not contained in explicit package at line 5, column 54. Violates encapsulation. (Severity: 4) Mixed high and low-precedence booleans at line 5, column 54. See page 70 of PBP. (Severity: 4) Hard tabs used at line 5, column 72. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 5, column 72. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 6, column 26. See page 51 of PBP. (Severity: 1) Postfix control quot;forquot; used at line 6, column 164. See page 96 of PBP. (Severity: 1) Hard tabs used at line 6, column 259. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 6, column 259. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 7, column 23. See page 51 of PBP. (Severity: 1) Postfix control quot;forquot; used at line 7, column 261. See page 96 of PBP. (Severity: 1) Postfix control quot;forquot; used at line 7, column 393. See page 96 of PBP. (Severity: 1) Postfix control quot;forquot; used at line 7, column 568. See page 96 of PBP. (Severity: 1) Postfix control quot;forquot; used at line 7, column 587. See page 96 of PBP. (Severity: 1) Hard tabs used at line 7, column 678. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 7, column 678. See page 51 of PBP. (Severity: 1) Hard tabs used at line 8, column 24. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 33, column 22. See page 51 of PBP. (Severity: 1) Mismatched operator at line 34, column 15. Numeric/string operators and operands should match. (Severity: 3) Useless interpolation of literal string at line 34, column 45. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 34, column 64. See page 51 of PBP. (Severity: 1) Mismatched operator at line 34, column 86. Numeric/string operators and operands should match. (Severity: 3) Useless interpolation of literal string at line 34, column 186. See page 51 of PBP. (Severity: 1) Hard tabs used at line 34, column 209. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 34, column 209. See page 51 of PBP. (Severity: 1)

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1)

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1)

Working with perltidy PERLTIDY(1) User Contributed Perl Documentation PERLTIDY(1) NAME perltidy - a perl script indenter and reformatter SYNOPSIS perltidy [ options ] file1 file2 file3 ... (output goes to file1.tdy, file2.tdy, ...) perltidy [ options ] file1 -o outfile perltidy [ options ] file1 -st >outfile perltidy [ options ] <infile >outfile

Working with perltidy $ cat .perltidyrc -l=78 # Max line width is 78 cols -i=2 # Indent level is 2 cols -ci=2 # Continuation indent is 2 cols -lp # line up parenthesis -vt=2 # Maximal vertical tightness -vtc=1 # medium vertical something tightness -cti=1 # No extra indentation for closing brackets -pt=1 # Medium parenthesis tightness -bt=1 # Medium brace tightness -sbt=1 # Medium square bracket tightness -bbt=1 # Medium block brace tightness -nsfs # No space before semicolons -nolq # Don't outdent long quoted strings -wbb=quot;% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=quot; # Break before all operators -nsak=quot;my local our if elsif until unless while for foreach return switch case given whenquot; -bar -cab=3 -wrs=quot;! ,quot; # want right space after these tokens -wls=quot;!quot; # want left space after !

Screencast demonstration removed for PDF

ZFML

$ perltidy index.zfml There is no previous '?' to match a ':' on line 4 4: <title>AcmeCorp: Widgets, Gadgets and Doodads</title> ^ 5: <meta http-equiv=quot;content-typequot; content=quot;text/html;charset=iso-8 ... -------------- ^ found bareword where operator expected (previous token underlined) 5: ... ent=quot;text/html;charset=iso-8859-1quot; /> -^ found > where term expected (previous token underlined) 7: <meta NAME=quot;keywordsquot; CONTENT=quot;AcmeCorp, widgets, gadgets ... ---------- ^ found bareword where operator expected (previous token underlined) 9: @import url(/AcmeCorp/templates/gateway85styles.css); ^ found Array where operator expected Missing ';' above? 9: @import url(/AcmeCorp/templates/gateway85styles.css); ------- ^ found bareword where operator expected (previous token underlined) 9: @import url(/AcmeCorp/templates/gateway85styles.css); ---------^ found bareword where operator expected (previous token underlined) Missing ';' above? to match a ':' on line 14 There is no previous '?' fix valid */ 14: max-height: 140px; /* to ^ Missing ';' above? 15 There is no previous '?' to match a ':' on line 15: padding: 12px; margin-top: 5px; border-top: 1px solid #e0e0e0; ^ There is no previous '?' to match a ':' on line 15 15: padding: 12px; margin-top: 5px; border-top: 1px solid #e0e0e0; ^ There is no previous '?' to match a ':' on line 15 15: padding: 12px; margin-top: 5px; border-top: 1px solid #e0e0e0; ^

Working with perlcritic $ perlcritic -1 myObj.pm myObj.pm source OK

That's great

but...

how does that help me? :-

Ensuring your tests fully exercise your code

Introducing Devel::Cover Devel::Cover(3) Perl Documentation Devel::Cover(3) NAME Devel::Cover - Code coverage metrics for Perl SYNOPSIS perl -MDevel::Cover yourprog args cover perl -MDevel::Cover=-db,cover_db,-coverage,statement,time yourprog args To test an uninstalled module: cover -delete HARNESS_PERL_SWITCHES=-MDevel::Cover make test cover

huh?

Introducing Devel::Cover $ perl -MDevel::Cover testobj.t 1..8 ok 1 - use myObj; ... # some Devel::Cover output snipped ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 Devel::Cover: Writing coverage database to /Users/kentcowgill/cover_db/runs/ 1169095517.23575.48192 ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ myObj.pm 100.0 n/a 100.0 100.0 n/a 23.5 100.0 testobj.t 100.0 n/a n/a 100.0 n/a 76.5 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------

Introducing cover $ cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ myObj.pm 100.0 n/a 100.0 100.0 n/a 23.5 100.0 testobj.t 100.0 n/a n/a 100.0 n/a 76.5 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------ Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done.

Introducing cover $ cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ myObj.pm 100.0 n/a 100.0 100.0 n/a 23.5 100.0 testobj.t 100.0 n/a n/a 100.0 n/a 76.5 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------ Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done.

html? :-D

Tweaking Devel::Cover Devel::Cover(3) Perl Documentation Devel::Cover(3) OPTIONS ... -ignore RE - Set REs of files to ignore +ignore RE - Append to REs of files to ignore.

Tweaking Devel::Cover $ perl -MDevel::Cover=+ignore,.*.t testobj.t 1..8 ok 1 - use myObj; ... # Devel::Cover output snipped Ignoring packages matching: /Devel/Cover[./] .*.t ... # Devel::Cover output snipped ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 Devel::Cover: Writing coverage database to /Users/kentcowgill/cover_db/runs/ 1169096938.23619.10353 ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ myObj.pm 100.0 n/a 100.0 100.0 n/a 100.0 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------

what happened to prove?

Tweaking prove $ prove -MDevel::Cover=+ignore,.*.t testobj.t

Tweaking prove $ prove -MDevel::Cover=+ignore,.*.t testobj.t Unknown option: M Unknown option: e Unknown option: e Unknown option: : Unknown option: : Unknown option: C Unknown option: o Unknown option: e Unknown option: = Unknown option: + Unknown option: i Unknown option: g Unknown option: n Unknown option: o Unknown option: e Unknown option: , Unknown option: . Unknown option: * Unknown option: .

ouch!

Tweaking prove $ PERL5OPT=-MDevel::Cover=+ignore,.*.t prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 3 wallclock secs ( 3.18 cusr + 0.08 csys = 3.26 CPU)

Tweaking prove $ cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ /usr/bin/prove 73.7 43.8 0.0 46.7 n/a 98.0 61.1 myObj.pm 100.0 n/a 100.0 100.0 n/a 2.0 100.0 Total 78.0 43.8 40.0 60.0 n/a 100.0 66.9 ---------------------------- ------ ------ ------ ------ ------ ------ ------ Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done.

uh, was that 'prove' in there?

Tweaking prove $ cover Reading database from /Users/kentco ---------------------------- ------ File stmt ---------------------------- ------ /usr/bin/prove 73.7 myObj.pm 100.0

Tweaking prove $ cover Reading database from /Users/kentco ---------------------------- ------ File stmt ---------------------------- ------ /usr/bin/prove 73.7 myObj.pm 100.0

yeah :(

Tweaking prove $ PERL5OPT=-MDevel::Cover=+ignore,.*.t,+ignore,prove prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 3 wallclock secs ( 3.18 cusr + 0.08 csys = 3.26 CPU)

Saving Some Typing $ cat Makefile OPENCMD = open BROWSER = /Applications/Safari.app clean: cover -delete test: prove testobj.t cover: make clean PERL5OPT=-MDevel::Cover=+ignore,.*.t,+ignore,prove make test 2>&1 cover make report report: $(OPENCMD) $(BROWSER) cover_db/coverage.html

Saving Some Typing $ make cover make clean cover -delete Deleting database /Users/kentcowgill/cover_db PERL5OPT=-MDevel::Cover=+ignore,.*.t,+ignore,prove make test 2>&1 prove testobj.t testobj....1..8 testobj....ok All tests successful. Files=1, Tests=8, 7 wallclock secs ( 3.22 cusr + 0.09 csys = 3.31 CPU) cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ myObj.pm 100.0 n/a 100.0 100.0 n/a 100.0 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------ Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done. make report open /Applications/Safari.app cover_db/coverage.html

100% yay! 8-D

Introducing Test::ZFML Test::Zfml(3) User Contributed Perl Documentation Test::Zfml(3) NAME Test::ZFML - Custom Test:: module built specifically for parsing ZFML. DESCRIPTION Long has it been lamented that AcmeCorp's implementation of ZFML (and who knows what that really stands for) is unmaintainable, and more importantly untestable. No more. Test::ZFML attempts to make the unparseable parseable, the unmaintain- able maintainable, and the untestable testable. It does this by implementing it's own mini ZFML parser and places chunks of ZFML inside their own package, surrounded by their own subroutines which have defined inputs and testable outputs.

Using Test::ZFML #!/usr/bin/perl use strict; use warnings; use Test::More qw/no_plan/; use Test::ZFML; use ZFML; my $p = ZFML->new(); my $file = q[test.zfml]; load_ok( $file, quot;Loaded ZFML file $filequot; ); parse_ok( $file, quot;Parsed ZFML file $filequot; ); evaluate_ok( $file, quot;Evaluated ZFML file $filequot; ); critique_ok( $file, quot;Critiqued ZFML file $filequot; );

That's great

but...

How about a demo?

Screencast demonstration removed for PDF

How'd you do that?

Test::Builder::Module NAME Test::Builder::Module - Base class for test modules SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1;

Test::Builder::Module NAME Test::Builder::Module - Base class for test modules SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; Start @EXPORT = qw(ok); Here sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1;

Test::ZFML package Test::ZFML; use strict; use warnings; use Perl::Critic qw/critique/; use Test::HTML::Lint (); use Carp; use lib '/Users/kentcowgill/acmecorp/lib'; use ZFML; use vars qw/$VERSION @ISA @EXPORT %EXPORT_TAGS $TODO/; use base q/Test::Builder::Module/; @EXPORT = qw/load_ok parse_ok evaluate_ok critique_ok replace_ok contains_ok lacks_ok html_ok/;

Test::ZFML Standard package Test::ZFML; stuff use strict; use warnings; use Perl::Critic qw/critique/; use Test::HTML::Lint (); use Carp; use lib '/Users/kentcowgill/acmecorp/lib'; use ZFML; use vars qw/$VERSION @ISA @EXPORT %EXPORT_TAGS $TODO/; use base q/Test::Builder::Module/; @EXPORT = qw/load_ok parse_ok evaluate_ok critique_ok replace_ok contains_ok lacks_ok html_ok/;

Test::ZFML # global regexes my $includeparse = qr/<!--s+__(TEMPLATE[sA-Z]*?)__s*?n(.*?)n-->/s; my $htmlparse = qr/<!--s+__([ A-Z_]+)__s*n(.*?)n-->/s; my $zfmlparse = qr/(<!--s+__(?:EVAL|INIT|POST) [^ ]+__s*n.*?n-->)/s; my $zfmlextract = qr/<!--s+__(EVAL|INIT|POST) ([^ ]+)__s*n(.*?)n-->/s;

Test::ZFML Icky regexes # global regexes my $includeparse = qr/<!--s+__(TEMPLATE[sA-Z]*?)__s*?n(.*?)n-->/s; my $htmlparse = qr/<!--s+__([ A-Z_]+)__s*n(.*?)n-->/s; my $zfmlparse = qr/(<!--s+__(?:EVAL|INIT|POST) [^ ]+__s*n.*?n-->)/s; my $zfmlextract = qr/<!--s+__(EVAL|INIT|POST) ([^ ]+)__s*n(.*?)n-->/s;

Test::ZFML sub load_ok { my $desc; ( $file_to_test, $desc ) = @_; _load_file( $file_to_test ); $zfml_filestate = LOADED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $file_contents has contents $tb->ok( $file_contents, $desc ); }

Test::ZFML Load the file sub load_ok { my $desc; ( $file_to_test, $desc ) = @_; _load_file( $file_to_test ); $zfml_filestate = LOADED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $file_contents has contents $tb->ok( $file_contents, $desc ); }

Test::ZFML sub _load_file { $file_to_test = shift; _get_contents( $file_contents, $file_to_test ); push @vars, grep { ! /^$(ENV|inp)/ } $file_contents =~ m/($[A-Z_]+)/g; return; }

Test::ZFML sub _load_file { $file_to_test = shift; _get_contents( $file_contents, $file_to_test ); push @vars, grep { ! /^$(ENV|inp)/ } $file_contents =~ m/($[A-Z_]+)/g; return; } Just does a slurp

Test::ZFML sub parse_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must load the file first' if $zfml_filestate != LOADED; _parse_file( $p ); $zfml_filestate = PARSED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $stuff got stuffed $tb->ok( $stuff, $desc ); }

Test::ZFML sub parse_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must load the file first' if $zfml_filestate != LOADED; _parse_file( $p ); $zfml_filestate = PARSED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $stuff got stuffed $tb->ok( $stuff, $desc ); Parse the } file

Test::ZFML sub _parse_file { my( $p ) = @_; # grab the executable hunks of perl code my @zfml = $file_contents =~ /$zfmlparse/g; $file_contents =~ s/$zfmlparse//g; # grab the hunks that are responsible for templates my %includes = $file_contents =~ /$includeparse/g; $file_contents =~ s/$includeparse//g; # finally, grab the hunks that get turned into HTML my %zfmlvars = $file_contents =~ /$htmlparse/g; $file_contents =~ s/$htmlparse//g; ...

Test::ZFML Really parse it sub _parse_file { my( $p ) = @_; # grab the executable hunks of perl code my @zfml = $file_contents =~ /$zfmlparse/g; $file_contents =~ s/$zfmlparse//g; # grab the hunks that are responsible for templates my %includes = $file_contents =~ /$includeparse/g; $file_contents =~ s/$includeparse//g; # finally, grab the hunks that get turned into HTML my %zfmlvars = $file_contents =~ /$htmlparse/g; $file_contents =~ s/$htmlparse//g; ...

Test::ZFML ... for my $key( keys %includes ){ # process all the include files :) my $tb = Test::Zfml->builder; $tb->ok( _get_includes( $key, $includes{ $key }, $file_to_test ), quot;Included $key file $includes{ $key }quot; ); } for my $key( keys %zfmlvars ){ $p->var->{$key} = $zfmlvars{$key}; } for my $zfml( @zfml ){ if( $zfml =~ m/$zfmlextract/s ) { push @{ $stuff->{$1} }, { $2 => $3 }; } } } # end

Test::ZFML ... for my $key( keys %includes ){ # process all the include files :) my $tb = Test::Zfml->builder; $tb->ok( _get_includes( $key, $includes{ $key }, $file_to_test ), quot;Included $key file $includes{ $key }quot; ); } Chug for my $key( keys %zfmlvars ){ $p->var->{$key} = $zfmlvars{$key}; } through for my $zfml( @zfml ){ it if( $zfml =~ m/$zfmlextract/s ) { push @{ $stuff->{$1} }, { $2 => $3 }; } } } # end

Test::ZFML sub _get_includes { my( $name, $file, $fromfile ) = @_; my $filepath = quot;$webroot/$filequot;; if( $filepath =~ /$VERSION/ ){ $filepath =~ s/$VERSION/$version/; } if( $filepath =~ /$LOCAL/ ){ my $path = $fromfile; $path =~ s/^.+?/(.+)/[a-z.]+$/$version/$1/; $filepath =~ s/$LOCAL/$path/; } my $tb = Test::ZFML->builder(); $tb->ok( -e $filepath, quot;Inlude/Template file ($filepath) Existsquot; ); ...

Test::ZFML Process sub _get_includes { my( $name, $file, $fromfile ) = @_; my $filepath = quot;$webroot/$filequot;; included if( $filepath =~ /$VERSION/ ){ files $filepath =~ s/$VERSION/$version/; } if( $filepath =~ /$LOCAL/ ){ my $path = $fromfile; $path =~ s/^.+?/(.+)/[a-z.]+$/$version/$1/; $filepath =~ s/$LOCAL/$path/; } my $tb = Test::ZFML->builder(); $tb->ok( -e $filepath, quot;Inlude/Template file ($filepath) Existsquot; ); ...

Test::ZFML ... open( my $tmp, '<', $filepath ) or die quot;can't open include filequot;; my @file = <$tmp>; my $contents; for my $line ( @file ){ $contents .= $line; if( $line =~ m/$([A-Z]+)s/ ){ eval quot;$testzfml::$1 = 'dummy content'quot;; } if( $line =~ m/var->{'([A-Z_]+)'}/ ){ eval quot;$testzfml::$1 = 'dummy content'quot;; } } my %includes = $contents =~ /$includeparse/g; for my $key( keys %includes ){ _get_includes( $key, $includes{ $key }, $file ); } close( $tmp ); }

Test::ZFML Evaluate, ... evaluate, open( my $tmp, '<', $filepath ) or die quot;can't open include filequot;; my @file = <$tmp>; evaluate my $contents; for my $line ( @file ){ $contents .= $line; if( $line =~ m/$([A-Z]+)s/ ){ eval quot;$testzfml::$1 = 'dummy content'quot;; } if( $line =~ m/var->{'([A-Z_]+)'}/ ){ eval quot;$testzfml::$1 = 'dummy content'quot;; } } my %includes = $contents =~ /$includeparse/g; for my $key( keys %includes ){ _get_includes( $key, $includes{ $key }, $file ); } close( $tmp ); }

Test::ZFML sub evaluate_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must parse the file first' if $zfml_filestate != PARSED; $zfml_filestate = EVALED; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _evaluate_code( $p, $hunk, $var, $evals->{$var}, $file, $desc ); } } } # loads everything into memory for testing require $_ for @cov_files; ## no critic }

Test::ZFML sub evaluate_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must parse the file first' if $zfml_filestate != PARSED; $zfml_filestate = EVALED; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _evaluate_code( $p, $hunk, $var, $evals->{$var}, $file, $desc ); } Really } } evaluate # loads everything into memory for testing require $_ for @cov_files; ## no critic it }

Test::ZFML sub _evaluate_code { my( $p, $eval_init, $name, $hunk, $file, $desc ) = @_; $file =~ s/.*/(.*)$/$1/; my $subname = quot;$eval_init$namequot;; $hunk = _wrap_hunk( $hunk, $subname ); my $filename = quot;$file.$subnamequot;; my $tb = Test::ZFML->builder; # Writing the contents out to a file so I can run # the tests with Devel::Cover turned on. open my $cov, '>', quot;.$filenamequot;; print {$cov} $hunk; close $cov; push @cov_files, quot;.$filenamequot;; eval quot;require '.$filename';quot;; ## no critic $tb->ok( ! $@, quot;$desc chunk ( $filename ) $@quot; ); eval quot;testzfml::$subname( $p );quot;; die quot;eval failed - $@quot; if $@; }

Test::ZFML sub _evaluate_code { my( $p, $eval_init, $name, $hunk, $file, $desc ) = @_; $file =~ s/.*/(.*)$/$1/; my $subname = quot;$eval_init$namequot;; $hunk = _wrap_hunk( $hunk, $subname ); my $filename = quot;$file.$subnamequot;; my $tb = Test::ZFML->builder; # Writing the contents out to a file so I can run # the tests with Devel::Cover turned on. open my $cov, '>', quot;.$filenamequot;; Write print {$cov} $hunk; close $cov; out files push @cov_files, quot;.$filenamequot;; eval quot;require '.$filename';quot;; ## no critic $tb->ok( ! $@, quot;$desc chunk ( $filename ) $@quot; ); for Code eval quot;testzfml::$subname( $p );quot;; die quot;eval failed - $@quot; if $@; } Coverage

Test::ZFML sub _wrap_hunk { my( $hunk, $subname ) = @_; # HEREDOCs inside eval aren't recognizable as HEREDOCs. # This re-quotes HEREDOCs as q()/qq() strings. if( $hunk =~ m/<</s ) { # replace all intended quoting chars with an HTML entity $hunk =~ s/|/&#124;/gs; $hunk =~ s/=s* # start of an assignment << # involving a heredoc ('|quot;) # using a quoting delimiter (?{ $1 eq q(quot;) ? 'qq' : 'q' }) # which we'll remember in $^R ([A-Z]+) # next the heredoc token 1; # close quoting delimiter (.*?)n # the heredoc 2 # closing heredoc token /= $^R|$3|;/gsx; # replace with quoting } ...

Test::ZFML sub _wrap_hunk { my( $hunk, $subname ) = @_; # HEREDOCs inside eval aren't recognizable as HEREDOCs. # This re-quotes HEREDOCs as q()/qq() strings. if( $hunk =~ m/<</s ) { # replace all intended quoting chars with an HTML entity $hunk =~ s/|/&#124;/gs; $hunk =~ s/=s* # start of an assignment << # involving a heredoc ('|quot;) # using a quoting delimiter (?{ $1 eq q(quot;) ? 'qq' : 'q' }) Wrap # which we'll remember in $^R Heredocs ([A-Z]+) # next the heredoc token 1; # close quoting delimiter (.*?)n # the heredoc 2 # closing heredoc token /= $^R|$3|;/gsx; # replace with quoting } ...

Test::ZFML ... my $chunk; # wrap the hunk with its own package, strictures and # warnings enabled, a sigwarn handler that causes eval # errors ($@) to throw a test ok() error, and callable via a # subroutine call. $chunk = <<quot;EOCquot;; package testzfml; use strict; use warnings; use ZFML; BEGIN { $SIG{'__WARN__'} = sub { die $_[0] } } ## no critic sub $subname { $hunk } 1; EOC return $chunk; }

Test::ZFML ... my $chunk; # wrap the hunk with its own package, strictures and # warnings enabled, a sigwarn handler that causes eval # errors ($@) to throw a test ok() error, and callable via a # subroutine call. $chunk = <<quot;EOCquot;; package testzfml; use strict; use warnings; use ZFML; BEGIN { $SIG{'__WARN__'} = sub { die $_[0] } } ## no critic sub $subname { Wrap it in $hunk } it's own 1; EOC namespace return $chunk; }

Test::ZFML sub critique_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _critique_code( $hunk, $var, $evals->{$var}, $desc ); } } } }

Test::ZFML sub critique_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _critique_code( $hunk, $var, $evals->{$var}, $desc ); } } } } Critique it

Test::ZFML sub _critique_code { my( $eval_init, $name, $hunk, $desc ) = @_; my $subname = quot;$eval_init$namequot;; my $problems = 0; $hunk = _wrap_hunk( $hunk, $subname ); my $tb = Test::ZFML->builder; for my $violation ( critique( { -severity => 1, -verbose => 1 }, $hunk ) ){ $tb->ok( ! $violation, quot;Critique problem: $violationquot; ); $problems++; } $tb->ok( ! $problems, quot;$desc chunk ( $subname )quot; ); return; }

Test::ZFML Report sub _critique_code { violations my( $eval_init, $name, $hunk, $desc ) = @_; my $subname = quot;$eval_init$namequot;; my $problems = 0; $hunk = _wrap_hunk( $hunk, $subname ); my $tb = Test::ZFML->builder; for my $violation ( critique( { -severity => 1, -verbose => 1 }, $hunk ) ){ $tb->ok( ! $violation, quot;Critique problem: $violationquot; ); $problems++; } $tb->ok( ! $problems, quot;$desc chunk ( $subname )quot; ); return; }

Test::ZFML sub replace_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; my $tb = Test::ZFML->builder; for my $var (@vars) { my $varname = $var; $varname =~ s/^$//; my $pname = $p->var->{$varname}; $tb->ok( $p->var->{$varname}, quot;$varname found in $filequot; ); $file_contents =~ s/Q$varE/$pname/g; } my %input = %{ $p->input }; $file_contents =~ s/$(input{)'?([A-Za-z_]+)'?}/$$1$2}/g; eval quot;$file_contents = qq|$file_contents|;quot;; }

Test::ZFML Replace sub replace_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; special my $tb = Test::ZFML->builder; for my $var (@vars) { variables my $varname = $var; $varname =~ s/^$//; my $pname = $p->var->{$varname}; $tb->ok( $p->var->{$varname}, quot;$varname found in $filequot; ); $file_contents =~ s/Q$varE/$pname/g; } my %input = %{ $p->input }; $file_contents =~ s/$(input{)'?([A-Za-z_]+)'?}/$$1$2}/g; eval quot;$file_contents = qq|$file_contents|;quot;; }

Test::ZFML sub contains_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->like( $file_contents, $regex, $desc ); }

Check Test::ZFML its' contents sub contains_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->like( $file_contents, $regex, $desc ); }

Test::ZFML sub lacks_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->unlike( $file_contents, $regex, $desc ); }

Test::ZFML sub lacks_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->unlike( $file_contents, $regex, $desc ); } Make sure it doesn't have specific bits

Test::ZFML sub html_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; Te

#use presentations

Add a comment

Related presentations

Related pages

Testing Code and Assuring Quality - scribd.com

Testing Code and Assuring Quality. Learning to use Test::More, Perl::Critic, and Devel::Cover Kent Cowgill Testing Code and Assuring Quality
Read more

Assuring Quality in Third-party Code Integrations | QA ...

Home > Assuring Quality in Third-party Code Integrations. ... Assuring Quality in Third-party Code Integrations ... Software Testing ...
Read more

Testing Code and Assuring Quality - YAPC::NA 2016

I will be talking about getting started with unit and functional testing using everyone's favorite language, Perl. Additionally, I will talk about code ...
Read more

On Assuring Software Quality and Curbing Software ...

... unit/module testing, code review, integration testing, system testing, ... ON ASSURING SOFTWARE QUALITY AND CURBING SOFTWARE DEVELOPMENT COST. 42 ...
Read more

Performance Testing - Software-Diagnostics Technology

Performance testing; Stability testing ; Code ... Assuring extensibility; Continuous Quality Supervision; Additionally to an initial code quality ...
Read more

Quality assurance - Wikipedia

Quality assurance (QA) is a way of preventing mistakes or defects in manufactured products and avoiding problems when delivering solutions or services to ...
Read more

Assuring standards and quality

Assuring standards and quality Quality assurance of UK higher education determines the academic ... The Quality Code .
Read more

Assuring Quality in Point-of-Care Testing

Assuring Quality in Point-of-Care Testing ... Context.—Managing the quality of point-of-care testing ... in bar code reader is used to identify the test ...
Read more

Assuring Quality and Usability in Open Source Software ...

Assuring Quality and Usability ... and fixing the code. The quality ... The most effective quality assurance techniques are testing and peer reviews.
Read more