Author: timbo
Date: Fri Jul 30 06:59:18 2010
New Revision: 14295
Modified:
dbi/trunk/t/40profile.t
dbi/trunk/t/41prof_dump.t
dbi/trunk/t/42prof_data.t
Log:
Fix profile tests to run in parallel.
(I just added a $$ to the file name. Not ideal but effective enough for now.)
Modified: dbi/trunk/t/40profile.t
==============================================================================
--- dbi/trunk/t/40profile.t (original)
+++ dbi/trunk/t/40profile.t Fri Jul 30 06:59:18 2010
@@ -38,7 +38,7 @@
$Data::Dumper::Terse = 1;
# log file to store profile results
-my $LOG_FILE = "profile.log";
+my $LOG_FILE = "profile$$.log";
my $orig_dbi_debug = $DBI::dbi_debug;
DBI->trace($DBI::dbi_debug, $LOG_FILE);
END {
Modified: dbi/trunk/t/41prof_dump.t
==============================================================================
--- dbi/trunk/t/41prof_dump.t (original)
+++ dbi/trunk/t/41prof_dump.t Fri Jul 30 06:59:18 2010
@@ -32,8 +32,9 @@
use_ok( 'DBI::ProfileDumper' );
}
+my $prof_file = "dbi$$.prof";
my $dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1, Profile=>"2/DBI::ProfileDumper" });
+ { RaiseError=>1,
Profile=>"2/DBI::ProfileDumper/File:$prof_file" });
isa_ok( $dbh, 'DBI::db' );
isa_ok( $dbh->{Profile}, "DBI::ProfileDumper" );
isa_ok( $dbh->{Profile}{Data}, 'HASH' );
@@ -62,10 +63,10 @@
undef $dbh;
# wrote the profile to disk?
-ok( -s "dbi.prof", 'Profile is on disk and nonzero size' );
+ok( -s $prof_file, 'Profile is on disk and nonzero size' );
# XXX We're breaking encapsulation here
-open(PROF, "dbi.prof") or die $!;
+open(PROF, $prof_file) or die $!;
my @prof = <PROF>;
close PROF;
@@ -85,7 +86,7 @@
# check that expected key is there
like(join('', @prof), qr/\+\s+1\s+\Q$sql\E/m);
-# unlink("dbi.prof"); # now done by 'make clean'
+# unlink($prof_file); # now done by 'make clean'
# should be able to load DBI::ProfileDumper::Apache outside apache
# this also naturally checks for syntax errors etc.
Modified: dbi/trunk/t/42prof_data.t
==============================================================================
--- dbi/trunk/t/42prof_data.t (original)
+++ dbi/trunk/t/42prof_data.t Fri Jul 30 06:59:18 2010
@@ -6,6 +6,7 @@
use DBI;
use Config;
use Test::More;
+use Data::Dumper;
BEGIN {
plan skip_all => 'profiling not supported for DBI::PurePerl'
@@ -28,8 +29,10 @@
my $sql = "select mode,size,name from ?";
+my $prof_file = "dbi$$.prof";
+
my $dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1, Profile=>"6/DBI::ProfileDumper" });
+ { RaiseError=>1,
Profile=>"6/DBI::ProfileDumper/File:$prof_file" });
isa_ok( $dbh, 'DBI::db', 'Created connection' );
# do a little work, but enough to ensure we don't get 0's on systems with low
res timers
@@ -48,10 +51,11 @@
# wrote the profile to disk?
-ok(-s "dbi.prof", "Profile written to disk, non-zero size" );
+ok(-s $prof_file, "Profile written to disk, non-zero size" );
# load up
my $prof = DBI::ProfileData->new(
+ File => $prof_file,
Filter => sub {
my ($path_ref, $data_ref) = @_;
$path_ref->[0] =~ s/set dummy=\d/set dummy=N/;
@@ -95,15 +99,16 @@
# take a look through Data
my $Data = $prof->Data;
print "SQL: $_\n" for keys %$Data;
-ok(exists($Data->{$sql}));
-ok(exists($Data->{$sql}{execute}));
+ok(exists($Data->{$sql}), "Data for '$sql' should exist")
+ or print Dumper($Data);
+ok(exists($Data->{$sql}{execute}), "Data for '$sql'->{execute} should exist");
# did the Filter convert set dummy=1 (etc) into set dummy=N?
ok(exists($Data->{"set dummy=N"}));
# test escaping of \n and \r in keys
$dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1, Profile=>"6/DBI::ProfileDumper" });
+ { RaiseError=>1,
Profile=>"6/DBI::ProfileDumper/File:$prof_file" });
isa_ok( $dbh, 'DBI::db', 'Created connection' );
my $sql2 = 'select size from . where name = "LITERAL: \r\n"';
@@ -126,15 +131,17 @@
undef $dbh;
# load dbi.prof
-$prof = DBI::ProfileData->new( DeleteFiles => 1 );
+$prof = DBI::ProfileData->new( File => $prof_file, DeleteFiles => 1 );
isa_ok( $prof, 'DBI::ProfileData' );
-ok(not(-e "dbi.prof"), "file should be deleted when DeleteFiles set" );
+ok(not(-e $prof_file), "file should be deleted when DeleteFiles set" );
# make sure the keys didn't get garbled
$Data = $prof->Data;
-ok(exists $Data->{$sql2});
-ok(exists $Data->{$sql3});
+ok(exists $Data->{$sql2}, "Data for '$sql2' should exist")
+ or print Dumper($Data);
+ok(exists $Data->{$sql3}, "Data for '$sql3' should exist")
+ or print Dumper($Data);
1;
