OK, one more for tonight. It's the last of the Test.pm-using .t files.
Index: t/41prof_dump.t
===================================================================
--- t/41prof_dump.t (revision 335)
+++ t/41prof_dump.t (working copy)
@@ -1,36 +1,27 @@
-#!perl -w
+#!perl -Tw
use strict;
-#
-# test script for DBI::ProfileDumper
-#
+use Test::More;
-use DBI;
-use DBI::ProfileDumper;
+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 => 11;
+ use_ok( 'DBI' );
+ use_ok( 'DBI::ProfileDumper' );
}
-use Test;
-BEGIN { plan tests => 7; }
-
-use Data::Dumper;
-$Data::Dumper::Indent = 1;
-$Data::Dumper::Terse = 1;
-
my $dbh = DBI->connect("dbi:ExampleP:", '', '',
{ RaiseError=>1, Profile=>"DBI::ProfileDumper" });
-ok(ref $dbh->{Profile}, "DBI::ProfileDumper");
-ok(ref $dbh->{Profile}{Data}, 'HASH');
-ok(ref $dbh->{Profile}{Path}, 'ARRAY');
+isa_ok( $dbh, 'DBI::db' );
+isa_ok( $dbh->{Profile}, "DBI::ProfileDumper" );
+isa_ok( $dbh->{Profile}{Data}, 'HASH' );
+isa_ok( $dbh->{Profile}{Path}, 'ARRAY' );
# do a little work
my $sql = "select mode,size,name from ?";
my $sth = $dbh->prepare($sql);
+isa_ok( $sth, 'DBI::st' );
$sth->execute(".");
$sth->{Profile}->flush_to_disk();
@@ -42,22 +33,21 @@
undef $dbh;
# wrote the profile to disk?
-ok(-s "dbi.prof");
+ok( -s "dbi.prof", 'Profile is on disk and nonzero size' );
open(PROF, "dbi.prof") or die $!;
my $prof = join('', <PROF>);
close PROF;
# has a header?
-ok($prof =~ /^DBI::ProfileDumper\s+([\d.]+)/);
+ok( $prof =~ /^DBI::ProfileDumper\s+([\d.]+)/, 'Found a version number' );
+# Can't use like() because we need $1
# version matches VERSION? (DBI::ProfileDumper uses $self->VERSION so
# it's a stringified version object that looks like N.N.N)
-ok($1, DBI::ProfileDumper->VERSION);
+is( $1, DBI::ProfileDumper->VERSION, 'Version numbers match' );
# check that expected key is there
-ok($prof =~ /\+\s+1\s+\Q$sql\E/m);
+like( $prof, qr/\+\s+1\s+\Q$sql\E/m );
# unlink("dbi.prof"); # now done by 'make clean'
-
-1;
--
Andy Lester => [EMAIL PROTECTED] => www.petdance.com => AIM:petdance
