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

Reply via email to