Author: timbo
Date: Mon Jul 26 02:39:28 2010
New Revision: 14284
Modified:
dbi/trunk/t/02dbidrv.t
Log:
expandtabs
Modified: dbi/trunk/t/02dbidrv.t
==============================================================================
--- dbi/trunk/t/02dbidrv.t (original)
+++ dbi/trunk/t/02dbidrv.t Mon Jul 26 02:39:28 2010
@@ -1,5 +1,5 @@
#!perl -w
-# vim:sw=4:ts=8
+# vim:sw=4:ts=8:et
$|=1;
use strict;
@@ -18,7 +18,7 @@
## load DBI
BEGIN {
- use_ok('DBI');
+ use_ok('DBI');
}
## ----------------------------------------------------------------------------
@@ -34,110 +34,110 @@
my $drh = undef;
sub driver {
- return $drh if $drh;
-
- Test::More::pass('... DBD::Test->driver called to getnew Driver
handle');
-
- my($class, $attr) = @_;
- $class = "${class}::dr";
- ($drh) = DBI::_new_drh($class, {
- Name => 'Test',
- Version => '$Revision:
11.11 $',
- },
- 77 # 'implementors data'
- );
-
- Test::More::ok($drh, "... new Driver handle ($drh) created
successfully");
- Test::More::isa_ok($drh, 'DBI::dr');
-
- return $drh;
+ return $drh if $drh;
+
+ Test::More::pass('... DBD::Test->driver called to getnew Driver
handle');
+
+ my($class, $attr) = @_;
+ $class = "${class}::dr";
+ ($drh) = DBI::_new_drh($class, {
+ Name => 'Test',
+ Version => '$Revision: 11.11 $',
+ },
+ 77 # 'implementors data'
+ );
+
+ Test::More::ok($drh, "... new Driver handle ($drh) created
successfully");
+ Test::More::isa_ok($drh, 'DBI::dr');
+
+ return $drh;
}
}
## Test Driver
{
- package DBD::Test::dr;
-
+ package DBD::Test::dr;
+
use strict;
- use warnings;
+ use warnings;
+
+ $DBD::Test::dr::imp_data_size = 0;
- $DBD::Test::dr::imp_data_size = 0;
-
Test::More::cmp_ok($DBD::Test::dr::imp_data_size, '==', 0, '... check
DBD::Test::dr::imp_data_size to avoid typo');
sub DESTROY { undef }
sub data_sources {
- my ($h) = @_;
-
- Test::More::ok($h, '... Driver object passed to data_sources');
- Test::More::isa_ok($h, 'DBI::dr');
- Test::More::ok(!tied $h, '... Driver object is not tied');
-
- return ("dbi:Test:foo", "dbi:Test:bar");
+ my ($h) = @_;
+
+ Test::More::ok($h, '... Driver object passed to data_sources');
+ Test::More::isa_ok($h, 'DBI::dr');
+ Test::More::ok(!tied $h, '... Driver object is not tied');
+
+ return ("dbi:Test:foo", "dbi:Test:bar");
}
}
## Test db package
{
- package DBD::Test::db;
+ package DBD::Test::db;
- use strict;
+ use strict;
+
+ $DBD::Test::db::imp_data_size = 0;
- $DBD::Test::db::imp_data_size = 0;
-
Test::More::cmp_ok($DBD::Test::db::imp_data_size, '==', 0, '... check
DBD::Test::db::imp_data_size to avoid typo');
sub do {
- my $h = shift;
+ my $h = shift;
- Test::More::ok($h, '... Database object passed to do');
- Test::More::isa_ok($h, 'DBI::db');
- Test::More::ok(!tied $h, '... Database object is not tied');
-
- my $drh_i = $h->{Driver};
-
- Test::More::ok($drh_i, '... got Driver object from Database
object with Driver attribute');
- Test::More::isa_ok($drh_i, "DBI::dr");
- Test::More::ok(!tied %{$drh_i}, '... Driver object is not
tied');
-
- my $drh_o = $h->FETCH('Driver');
-
- Test::More::ok($drh_o, '... got Driver object from Database
object by FETCH-ing Driver attribute');
- Test::More::isa_ok($drh_o, "DBI::dr");
- SKIP: {
- Test::More::skip "running DBI::PurePerl", 1 if
$DBI::PurePerl;
- Test::More::ok(tied %{$drh_o}, '... Driver object is
not tied');
- }
-
- # return this to make our test pass
- return 1;
+ Test::More::ok($h, '... Database object passed to do');
+ Test::More::isa_ok($h, 'DBI::db');
+ Test::More::ok(!tied $h, '... Database object is not tied');
+
+ my $drh_i = $h->{Driver};
+
+ Test::More::ok($drh_i, '... got Driver object from Database object
with Driver attribute');
+ Test::More::isa_ok($drh_i, "DBI::dr");
+ Test::More::ok(!tied %{$drh_i}, '... Driver object is not tied');
+
+ my $drh_o = $h->FETCH('Driver');
+
+ Test::More::ok($drh_o, '... got Driver object from Database object by
FETCH-ing Driver attribute');
+ Test::More::isa_ok($drh_o, "DBI::dr");
+ SKIP: {
+ Test::More::skip "running DBI::PurePerl", 1 if $DBI::PurePerl;
+ Test::More::ok(tied %{$drh_o}, '... Driver object is not tied');
+ }
+
+ # return this to make our test pass
+ return 1;
}
- sub data_sources {
- my ($dbh, $attr) = @_;
- my @ds = $dbh->SUPER::data_sources($attr);
-
- Test::More::is_deeply((
- \...@ds,
- [ 'dbi:Test:foo', 'dbi:Test:bar' ]
- ),
- '... checking fetched datasources from Driver'
- );
-
- push @ds, "dbi:Test:baz";
- return @ds;
+ sub data_sources {
+ my ($dbh, $attr) = @_;
+ my @ds = $dbh->SUPER::data_sources($attr);
+
+ Test::More::is_deeply((
+ \...@ds,
+ [ 'dbi:Test:foo', 'dbi:Test:bar' ]
+ ),
+ '... checking fetched datasources from Driver'
+ );
+
+ push @ds, "dbi:Test:baz";
+ return @ds;
}
sub disconnect {
- shift->STORE(Active => 0);
+ shift->STORE(Active => 0);
}
}
## ----------------------------------------------------------------------------
## test the Driver (DBD::Test)
-$INC{'DBD/Test.pm'} = 'dummy'; # required to fool DBI->install_driver()
+$INC{'DBD/Test.pm'} = 'dummy'; # required to fool DBI->install_driver()
# Note that install_driver should *not* normally be called directly.
# This test does so only because it's a test of install_driver!
@@ -151,9 +151,9 @@
my @ds1 = DBI->data_sources("Test");
is_deeply((
- [ @ds1 ],
- [ 'dbi:Test:foo', 'dbi:Test:bar' ]
- ), '... got correct datasources from DBI->data_sources("Test")'
+ [ @ds1 ],
+ [ 'dbi:Test:foo', 'dbi:Test:bar' ]
+ ), '... got correct datasources from DBI->data_sources("Test")'
);
SKIP: {
@@ -163,12 +163,12 @@
}
# create scope to test $dbh DESTROY behaviour
-do {
+do {
- my $dbh = $drh->connect;
-
- ok($dbh, '... got a database handle from calling $drh->connect');
- isa_ok($dbh, 'DBI::db');
+ my $dbh = $drh->connect;
+
+ ok($dbh, '... got a database handle from calling $drh->connect');
+ isa_ok($dbh, 'DBI::db');
SKIP: {
skip "Kids attribute not supported under DBI::PurePerl", 1 if
$DBI::PurePerl;
@@ -176,22 +176,22 @@
cmp_ok($drh->{Kids}, '==', 1, '... this Driver does not yet have any
Kids');
}
- my @ds2 = $dbh->data_sources();
- is_deeply((
- [ @ds2 ],
- [ 'dbi:Test:foo', 'dbi:Test:bar', 'dbi:Test:baz' ]
- ), '... got correct datasources from $dbh->data_sources()'
- );
-
- ok($dbh->do('dummy'), '... this will trigger more driver internal tests
above in DBD::Test::db');
-
- $dbh->disconnect;
-
- $drh->set_err("41", "foo 41 drh");
- cmp_ok($drh->err, '==', 41, '... checking Driver handle err set with
set_err method');
- $dbh->set_err("42", "foo 42 dbh");
- cmp_ok($dbh->err, '==', 42, '... checking Database handle err set with
set_err method');
- cmp_ok($drh->err, '==', 41, '... checking Database handle err set with
Driver handle set_err method');
+ my @ds2 = $dbh->data_sources();
+ is_deeply((
+ [ @ds2 ],
+ [ 'dbi:Test:foo', 'dbi:Test:bar', 'dbi:Test:baz' ]
+ ), '... got correct datasources from $dbh->data_sources()'
+ );
+
+ ok($dbh->do('dummy'), '... this will trigger more driver internal tests
above in DBD::Test::db');
+
+ $dbh->disconnect;
+
+ $drh->set_err("41", "foo 41 drh");
+ cmp_ok($drh->err, '==', 41, '... checking Driver handle err set with
set_err method');
+ $dbh->set_err("42", "foo 42 dbh");
+ cmp_ok($dbh->err, '==', 42, '... checking Database handle err set with
set_err method');
+ cmp_ok($drh->err, '==', 41, '... checking Database handle err set with
Driver handle set_err method');
};
@@ -220,11 +220,11 @@
is($DBI::state, 'IM999', '... checking $DBI::state');
SKIP: {
- skip "using DBI::PurePerl", 1 if $DBI::PurePerl;
- eval {
- $DBI::rows = 1
- };
- like($@, qr/Can't modify/, '... trying to assign to $DBI::rows should
throw an excpetion'); #'
+ skip "using DBI::PurePerl", 1 if $DBI::PurePerl;
+ eval {
+ $DBI::rows = 1
+ };
+ like($@, qr/Can't modify/, '... trying to assign to $DBI::rows should
throw an excpetion'); #'
}
is($drh->{FetchHashKeyName}, 'NAME', '... FetchHashKeyName is NAME');
@@ -237,18 +237,18 @@
ok($drh->dbixs_revision =~ m/^\d+$/, 'has integer dbixs_revision');
SKIP: {
- skip "using DBI::PurePerl", 5 if $DBI::PurePerl;
- my $can = $drh->can('FETCH');
+ skip "using DBI::PurePerl", 5 if $DBI::PurePerl;
+ my $can = $drh->can('FETCH');
- ok($can, '... $drh can FETCH');
- is(ref($can), "CODE", '... and it returned a proper CODE ref');
+ ok($can, '... $drh can FETCH');
+ is(ref($can), "CODE", '... and it returned a proper CODE ref');
- my $name = $can->($drh, "Name");
+ my $name = $can->($drh, "Name");
- ok($name, '... used FETCH returned from can to fetch the Name
attribute');
- is($name, "Test", '... the Name attribute is equal to Test');
+ ok($name, '... used FETCH returned from can to fetch the Name attribute');
+ is($name, "Test", '... the Name attribute is equal to Test');
- ok(!$drh->can('disconnect_all'), '... ');
+ ok(!$drh->can('disconnect_all'), '... ');
}
1;
