Author: timbo
Date: Thu Mar 11 04:32:04 2004
New Revision: 215

Modified:
   dbi/trunk/t/01basics.t
   dbi/trunk/t/50dbm.t
Log:
Make t/50dbm.t more conservative about which extensions it uses.
Add timeout and hints to 01basics.t about effect of bad drivers.


Modified: dbi/trunk/t/01basics.t
==============================================================================
--- dbi/trunk/t/01basics.t      (original)
+++ dbi/trunk/t/01basics.t      Thu Mar 11 04:32:04 2004
@@ -116,8 +116,14 @@
   ok(0, DBI::hash("foo2",1) == -1263462437,  DBI::hash("foo2",1));
 }
 
-print "test DBI->installed_versions (for @drivers)\n";
-print "(a bad driver can kill the process here)\n";
+print "Test DBI->installed_versions (for @drivers)\n";
+print "(If one of those drivers, or the configuration for it, is bad\n";
+print "then these tests can kill or freeze the process here. That's not the DBI's 
fault.)\n";
+$SIG{ALRM} = sub {
+    die "Test aborted because a driver (one of: @drivers) hung while loading"
+       ." (almost certainly NOT a DBI problem)";
+};
+alarm(20);
 my $installed_versions = DBI->installed_versions;
 ok(0, ref $installed_versions eq 'HASH');
 ok(0, %$installed_versions);

Modified: dbi/trunk/t/50dbm.t
==============================================================================
--- dbi/trunk/t/50dbm.t (original)
+++ dbi/trunk/t/50dbm.t Thu Mar 11 04:32:04 2004
@@ -2,10 +2,22 @@
 use strict;
 use File::Path;
 use Test::More;
+use Config qw(%Config);
 
 use DBI;
 use vars qw( @mldbm_types @dbm_types );
 BEGIN {
+
+    # Be conservative about what modules we use here.
+    # We don't want to be tripped up by a badly installed module
+    # so we remove from @INC any version-specific dirs that don't
+    # also have an arch-specific dir.
+    my %inc = map { $_ => 1 } @INC;
+    my @del = grep { m:/5\.[0-9.]+$: && !$inc{"$_/$Config{archname}"} } @INC;
+    my %del = map { $_ => 1 } @del;
+    @INC = grep { !$del{$_} } @INC;
+    print "Removed some old dirs from [EMAIL PROTECTED] for this test: @del\n" if 
@del;
+
     # 0=SQL::Statement if avail, 1=DBI::SQL::Nano
     # next line forces use of Nano rather than default behaviour
     $ENV{DBI_SQL_NANO}=1;

Reply via email to