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