Why should you guys have all the fun? Here's my patch. * Adds a -T flag ('cause really, shouldn't all of DBI be able to run under taint mode?) * Uses Test::More instead of Test. * Escapes out properly with skip_all. * Adds an isa_ok() for all object creation statements. * Added some comments here and there.
xoxo, Andy Index: t/42prof_data.t =================================================================== --- t/42prof_data.t (revision 335) +++ t/42prof_data.t (working copy) @@ -1,24 +1,17 @@ -#!perl -w +#!perl -wT use strict; -# -# test script for DBI::ProfileData -# +use Test::More; -use DBI; -use DBI::ProfileDumper; -use DBI::ProfileData; +plan skip_all => "profiling not supported for DBI::PurePerl" if $DBI::PurePerl; BEGIN { - if ($DBI::PurePerl) { - print "1..0 # Skipped: profiling not supported for DBI::PurePerl\n"; - exit 0; - } + plan tests=>33; + use_ok( 'DBI' ); + use_ok( 'DBI::ProfileDumper' ); + use_ok( 'DBI::ProfileData' ); } -use Test; -BEGIN { plan tests => 18; } - use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Terse = 1; @@ -27,10 +20,12 @@ my $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1, Profile=>"6/DBI::ProfileDumper" }); +isa_ok( $dbh, 'DBI::db', 'Created connection' ); # do a little work foreach (1,2,3) { my $sth = $dbh->prepare($sql); + isa_ok( $sth, 'DBI::st', 'Created handle' ); for my $loop (1..20) { $sth->execute("."); $sth->fetchrow_hashref; @@ -43,31 +38,30 @@ # wrote the profile to disk? -ok(-s "dbi.prof"); +ok(-s "dbi.prof", "Profile written to disk, non-zero size" ); # load up my $prof = DBI::ProfileData->new(); -ok($prof); -ok(ref $prof eq 'DBI::ProfileData'); +isa_ok( $prof, 'DBI::ProfileData' ); +cmp_ok( $prof->count, '>=', 3, 'At least 3 profile data items' ); -ok($prof->count() >= 3); - # try a few sorts my $nodes = $prof->nodes; $prof->sort(field => "longest"); my $longest = $nodes->[0][4]; -ok($longest); +ok( $longest, 'Longest is non-zero' ); $prof->sort(field => "longest", reverse => 1); -ok($nodes->[0][4] < $longest); +cmp_ok( $nodes->[0][4], '<', $longest ); $prof->sort(field => "count"); my $most = $nodes->[0]; ok($most); $prof->sort(field => "count", reverse => 1); -ok($nodes->[0][0] < $most->[0]); +cmp_ok( $nodes->[0][0], '<', $most->[0] ); # remove the top count and make sure it's gone my $clone = $prof->clone(); +isa_ok( $clone, 'DBI::ProfileData' ); $clone->sort(field => "count"); ok($clone->exclude(key1 => $most->[7])); @@ -78,6 +72,7 @@ # there can only be one $clone = $prof->clone(); +isa_ok( $clone, 'DBI::ProfileData' ); ok($clone->match(key1 => $clone->nodes->[0][7])); ok($clone->match(key2 => $clone->nodes->[0][8])); ok($clone->count == 1); @@ -90,6 +85,7 @@ # test escaping of \n and \r in keys $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1, Profile=>"6/DBI::ProfileDumper" }); +isa_ok( $dbh, 'DBI::db', 'Created connection' ); my $sql2 = 'select size from . where name = "LITERAL: \r\n"'; my $sql3 = "select size from . where name = \"EXPANDED: \r\n\""; @@ -97,10 +93,12 @@ # do a little work foreach (1,2,3) { my $sth2 = $dbh->prepare($sql2); + isa_ok( $sth2, 'DBI::st' ); $sth2->execute(); $sth2->fetchrow_hashref; $sth2->finish; my $sth3 = $dbh->prepare($sql3); + isa_ok( $sth3, 'DBI::st' ); $sth3->execute(); $sth3->fetchrow_hashref; $sth3->finish; @@ -109,7 +107,7 @@ # load dbi.prof $prof = DBI::ProfileData->new(); -ok($prof and ref $prof eq 'DBI::ProfileData'); +isa_ok( $prof, 'DBI::ProfileData' ); # make sure the keys didn't get garbled $Data = $prof->Data; -- Andy Lester => [EMAIL PROTECTED] => www.petdance.com => AIM:petdance