Author: REHSACK
Date: Wed Jul 28 05:37:28 2010
New Revision: 14291
Added:
dbi/trunk/t/lib.pl
Modified:
dbi/trunk/Changes
dbi/trunk/MANIFEST
dbi/trunk/t/10examp.t
dbi/trunk/t/49dbd_file.t
dbi/trunk/t/50dbm_simple.t
dbi/trunk/t/51dbm_file.t
dbi/trunk/t/52dbm_complex.t
dbi/trunk/t/85gofer.t
Log:
Fix tests failing when ran parallel
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Wed Jul 28 05:37:28 2010
@@ -10,6 +10,7 @@
Added $h->{AutoInactiveDestroy} as simpler safer form of
$h->{InactiveDestroy} (David E. Wheeler)
+ Fix tests failing when ran parallel (Jens Rehsack)
=head2 Changes in DBI 1.613 (svn r14271) 22nd July 2010
Modified: dbi/trunk/MANIFEST
==============================================================================
--- dbi/trunk/MANIFEST (original)
+++ dbi/trunk/MANIFEST Wed Jul 28 05:37:28 2010
@@ -106,6 +106,7 @@
t/86gofer_fail.t
t/87gofer_cache.t
t/90sql_type_cast.t
+t/lib.pl Utility functions for test scripts
t/pod.t
t/pod-coverage.t
test.pl Assorted informal tests, including tests for
memory leaks
Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t (original)
+++ dbi/trunk/t/10examp.t Wed Jul 28 05:37:28 2010
@@ -18,7 +18,7 @@
# provide some protection against growth in size of '.' during the test
# which was probable cause of this failure
# http://www.nntp.perl.org/group/perl.cpan.testers/2009/09/msg5297317.html
- my $tmpfile = "deleteme";
+ my $tmpfile = "deleteme_$$";
open my $fh, ">$tmpfile";
close $fh;
unlink $tmpfile;
@@ -137,13 +137,14 @@
ok("@{[sort keys %{$csr_b->{NAME_uc_hash}}]}" eq "MODE NAME SIZE");
ok("@{[sort values %{$csr_b->{NAME_uc_hash}}]}" eq "0 1 2");
+do "t/lib.pl";
# get a dir always readable on all platforms
-my $dir = getcwd() || cwd();
-$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
+#my $dir = getcwd() || cwd();
+#$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
# untaint $dir
#$dir =~ m/(.*)/; $dir = $1 || die;
-
+my $dir = test_dir ();
# ---
Modified: dbi/trunk/t/49dbd_file.t
==============================================================================
--- dbi/trunk/t/49dbd_file.t (original)
+++ dbi/trunk/t/49dbd_file.t Wed Jul 28 05:37:28 2010
@@ -17,10 +17,9 @@
use_ok ("DBI");
use_ok ("DBD::File");
-my $dir = File::Spec->catdir (getcwd (), "test_output");
+do "t/lib.pl";
-rmtree $dir;
-mkpath $dir;
+my $dir = test_dir ();
my $rowidx = 0;
my @rows = ( [ "Hello World" ], [ "Hello DBI Developers" ], );
Modified: dbi/trunk/t/50dbm_simple.t
==============================================================================
--- dbi/trunk/t/50dbm_simple.t (original)
+++ dbi/trunk/t/50dbm_simple.t Wed Jul 28 05:37:28 2010
@@ -75,10 +75,9 @@
}
}
-my $dir = File::Spec->catdir(getcwd(),'test_output');
+do "t/lib.pl";
-rmtree $dir; END { rmtree $dir }
-mkpath $dir;
+my $dir = test_dir ();
my %tests_statement_results = (
2 => [
Modified: dbi/trunk/t/51dbm_file.t
==============================================================================
--- dbi/trunk/t/51dbm_file.t (original)
+++ dbi/trunk/t/51dbm_file.t Wed Jul 28 05:37:28 2010
@@ -11,10 +11,9 @@
use DBI;
-my $dir = File::Spec->catdir(getcwd(),'test_output');
+do "t/lib.pl";
-rmtree $dir; END { rmtree $dir }
-mkpath $dir;
+my $dir = test_dir ();
my $dbh = DBI->connect('dbi:DBM:', undef, undef, {
f_dir => $dir,
Modified: dbi/trunk/t/52dbm_complex.t
==============================================================================
--- dbi/trunk/t/52dbm_complex.t (original)
+++ dbi/trunk/t/52dbm_complex.t Wed Jul 28 05:37:28 2010
@@ -87,11 +87,9 @@
}
}
-my $dir = File::Spec->catdir( getcwd(), 'test_output' );
+do "t/lib.pl";
-rmtree $dir;
-END { rmtree $dir }
-mkpath $dir;
+my $dir = test_dir ();
plan skip_all => "Not running with SQL::Statement" unless ( $haveSS and
@mldbm_types );
plan skip_all => "Needs more love to run with Gofer, too" if( $using_dbd_gofer
);
Modified: dbi/trunk/t/85gofer.t
==============================================================================
--- dbi/trunk/t/85gofer.t (original)
+++ dbi/trunk/t/85gofer.t Wed Jul 28 05:37:28 2010
@@ -20,6 +20,8 @@
if $ap !~ /policy=pedantic\b/i;
}
+do "t/lib.pl";
+
# 0=SQL::Statement if avail, 1=DBI::SQL::Nano
# next line forces use of Nano rather than default behaviour
# $ENV{DBI_SQL_NANO}=1;
@@ -45,13 +47,16 @@
}
plan skip_all => 'No DBM modules available' if !$opt_dbm;
}
-my $remote_driver_dsn = "dbm_type=$opt_dbm;lockfile=0";
-my $remote_dsn = "dbi:DBM:$remote_driver_dsn";
+
+my @remote_dsns = DBI->data_sources( "dbi:DBM:", {
+ dbm_type => $opt_dbm,
+ f_lockfile => 0,
+ f_dir => test_dir() } );
+my $remote_dsn = $remote_dsns[0];
+( my $remote_driver_dsn = $remote_dsn ) =~ s/dbi:dbm://i;
# Long timeout for slow/overloaded systems (incl virtual machines with low
priority)
my $timeout = 240;
-plan 'no_plan';
-
if ($ENV{DBI_AUTOPROXY}) {
# this means we have DBD::Gofer => DBD::Gofer => DBD::DBM!
# rather than disable it we let it run because we're twisted
@@ -254,5 +259,6 @@
undef; # error in $@
}
+done_testing;
1;
Added: dbi/trunk/t/lib.pl
==============================================================================
--- (empty file)
+++ dbi/trunk/t/lib.pl Wed Jul 28 05:37:28 2010
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+# lib.pl is the file where database specific things should live,
+# whereever possible. For example, you define certain constants
+# here and the like.
+
+use strict;
+
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+my $test_dir;
+END { defined( $test_dir ) and rmtree $test_dir }
+
+sub test_dir
+{
+ unless( defined( $test_dir ) )
+ {
+ $test_dir = File::Spec->rel2abs( File::Spec->curdir () );
+ $test_dir = File::Spec->catdir ( $test_dir, "test_output_" . $$ );
+ $test_dir .= "_" . basename($0, qr/\.[^.]*/);
+ $test_dir = VMS::Filespec::unixify($test_dir) if $^O eq 'VMS';
+ rmtree $test_dir;
+ mkpath $test_dir;
+ }
+
+ return $test_dir;
+}
+
+1;
