Author: timbo
Date: Tue Mar 16 02:01:20 2004
New Revision: 234
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/dbiprof.PL
dbi/trunk/lib/DBI/ProfileData.pm
dbi/trunk/t/03handle.t
dbi/trunk/t/04mods.t
dbi/trunk/t/05thrclone.t
dbi/trunk/t/06attrs.t
dbi/trunk/t/09trace.t
dbi/trunk/t/20meta.t
dbi/trunk/t/50dbm.t
Log:
Changed more tests to use Test::More thanks to Andy Lester,
including some pod fixes.
Fixes for previous checkin.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Mar 16 02:01:20 2004
@@ -13,6 +13,7 @@
Changed selectall_arrayref() to call finish() if
$attr->{MaxRows} is defined.
+ Changed more tests to use Test::More thanks to Andy Lester.
=head1 CHANGES in DBI 1.42 (svn rev 222), 12th March 2004
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Tue Mar 16 02:01:20 2004
@@ -640,8 +640,8 @@
# if the caller has provided a callback then call it
# especially useful with connect_cached() XXX not enabled/tested/documented
- if (0 && $dbh && my $oc = $dbh->{OnConnect}) { # XXX
- $oc->($dbh, $dsn, $user, $auth, $attr) if ref $oc eq 'CODE';
+ if (0 and $dbh and my $oc = $dbh->{OnConnect}) { # XXX
+ $oc->($dbh, $dsn, $user, $pass, $attr) if ref $oc eq 'CODE';
}
DBI->trace_msg(" <- connect= $dbh\n") if $DBI::dbi_debug;
Modified: dbi/trunk/dbiprof.PL
==============================================================================
--- dbi/trunk/dbiprof.PL (original)
+++ dbi/trunk/dbiprof.PL Tue Mar 16 02:01:20 2004
@@ -187,6 +187,8 @@
Print the dbiprof version number and exit.
+=back
+
=head1 AUTHOR
Sam Tregar <[EMAIL PROTECTED]>
Modified: dbi/trunk/lib/DBI/ProfileData.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileData.pm (original)
+++ dbi/trunk/lib/DBI/ProfileData.pm Tue Mar 16 02:01:20 2004
@@ -625,6 +625,8 @@
__END__
+=back
+
=head1 AUTHOR
Sam Tregar <[EMAIL PROTECTED]>
Modified: dbi/trunk/t/03handle.t
==============================================================================
--- dbi/trunk/t/03handle.t (original)
+++ dbi/trunk/t/03handle.t Tue Mar 16 02:01:20 2004
@@ -1,19 +1,18 @@
#!perl -w
use strict;
-use Test::More;
+use Test::More tests => 68;
use Data::Dumper;
# handle tests
-BEGIN { plan tests => 52 }
-
-use DBI;
+BEGIN { use_ok( 'DBI' ) }
my $driver = "ExampleP";
do {
my $dbh = DBI->connect("dbi:$driver:", '', '');
+ isa_ok( $dbh, 'DBI::db' );
my $sql = "select name from ?";
my $sth1 = $dbh->prepare_cached($sql);
@@ -25,7 +24,7 @@
local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /still active/ };
my $sth2 = $dbh->prepare_cached($sql);
ok($sth1 == $sth2);
- ok($warn == 1);
+ is($warn, 1);
ok(!$sth1->{Active});
$sth2 = $dbh->prepare_cached($sql, { foo => 1 });
@@ -35,6 +34,7 @@
ok($sth1->execute("."));
ok($sth1->{Active});
$sth2 = $dbh->prepare_cached($sql, undef, 3);
+ isa_ok( $sth2, 'DBI::st' );
ok($sth1 != $sth2);
ok($sth1->{Active}); # active but no longer cached
$sth1->finish;
@@ -42,6 +42,7 @@
ok($sth2->execute("."));
ok($sth2->{Active});
$sth1 = $dbh->prepare_cached($sql, undef, 1);
+ isa_ok( $sth2, 'DBI::st' );
ok($sth1 == $sth2);
ok(!$sth2->{Active});
@@ -50,7 +51,7 @@
};
my $drh = DBI->install_driver($driver);
-ok($drh);
+isa_ok( $drh, 'DBI::dr' );
is($drh->{Kids}, 0);
@@ -59,9 +60,20 @@
sub work {
my (%args) = @_;
my $dbh = DBI->connect("dbi:$driver:", '', '');
- ok(ref $dbh->{Driver}) if $args{Driver};
+ isa_ok( $dbh, 'DBI::db' );
+ if ( $args{Driver} ) {
+ isa_ok( $dbh->{Driver}, 'DBI::dr' );
+ } else {
+ pass( "No driver passed" );
+ }
+
my $sth = $dbh->prepare_cached("select name from ?");
- ok(ref $sth->{Database}) if $args{Database};
+ isa_ok( $sth, 'DBI::st' );
+ if ( $args{Database} ) {
+ isa_ok( $sth->{Database}, 'DBI::db' );
+ } else {
+ pass( "No database passed" );
+ }
$dbh->disconnect;
# both handles should be freed here
}
Modified: dbi/trunk/t/04mods.t
==============================================================================
--- dbi/trunk/t/04mods.t (original)
+++ dbi/trunk/t/04mods.t Tue Mar 16 02:01:20 2004
@@ -1,15 +1,11 @@
#!perl -w
use strict;
-use Test;
+use Test::More tests=>6;
-BEGIN { plan tests => 3 }
-
-use DBI;
-
-use DBI::Const::GetInfoType qw(%GetInfoType);
-
-use DBI::Const::GetInfoReturn qw(%GetInfoReturnTypes %GetInfoReturnValues);
+BEGIN { use_ok( 'DBI' ); }
+BEGIN { use_ok( 'DBI::Const::GetInfoType', qw(%GetInfoType) ); }
+BEGIN { use_ok( 'DBI::Const::GetInfoReturn', qw(%GetInfoReturnTypes
%GetInfoReturnValues) ); }
ok(keys %GetInfoType);
Modified: dbi/trunk/t/05thrclone.t
==============================================================================
--- dbi/trunk/t/05thrclone.t (original)
+++ dbi/trunk/t/05thrclone.t Tue Mar 16 02:01:20 2004
@@ -29,13 +29,13 @@
my @connect_args = ("dbi:ExampleP:", '', '');
my $dbh_parent = DBI->connect_cached(@connect_args);
-ok($dbh_parent);
+isa_ok( $dbh_parent, 'DBI::db' );
sub tests1 {
is($DBI::neat_maxlen, 12345);
my $dbh = DBI->connect_cached(@connect_args);
- ok($dbh);
+ isa_ok( $dbh, 'DBI::db' );
isnt($dbh, $dbh_parent);
is($dbh->{Driver}->{Kids}, 1) unless $DBI::PurePerl && ok(1);
}
Modified: dbi/trunk/t/06attrs.t
==============================================================================
--- dbi/trunk/t/06attrs.t (original)
+++ dbi/trunk/t/06attrs.t Tue Mar 16 02:01:20 2004
@@ -1,19 +1,18 @@
#!perl -w
use strict;
-use Test::More;
-use DBI;
+use Test::More tests => 144;
-BEGIN { plan tests => 143 }
+BEGIN { use_ok( 'DBI' ) }
$|=1;
# Connect to the example driver.
-ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
+my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
{ PrintError => 0,
RaiseError => 1,
- })
-);
+ });
+isa_ok( $dbh, 'DBI::db' );
# Clean up when we're done.
END { $dbh->disconnect if $dbh };
@@ -68,7 +67,7 @@
# ------ Test the driver handle attributes.
ok( my $drh = $dbh->{Driver} );
-ok( UNIVERSAL::isa($drh, 'DBI::dr') );
+isa_ok( $drh, 'DBI::dr' );
ok( $dbh->err );
is( $drh->{ErrCount}, 0 );
@@ -114,7 +113,7 @@
eval { $sth->execute };
ok( $err = $@ );
# we don't check actual opendir error msg because of locale differences
-ok( $err =~ /^DBD::(ExampleP|Multiplex)::st execute failed: opendir\(foo\): /i ) or
print "[EMAIL PROTECTED]";
+like( $err, qr/^DBD::(ExampleP|Multiplex)::st execute failed: opendir\(foo\): /i );
# Test all of the statement handle attributes.
ok( $sth->errstr =~ /^opendir\(foo\): / ) or print "errstr: ".$sth->errstr."\n";
@@ -125,7 +124,7 @@
is( $sth->{ErrCount}, 1 );
eval { $sth->{ErrCount} = 42 };
ok($@);
-ok($@ =~ m/STORE failed:/);
+like($@, qr/STORE failed:/);
is( $sth->{ErrCount}, 42 );
$sth->{ErrCount} = 0;
is( $sth->{ErrCount}, 0 );
Modified: dbi/trunk/t/09trace.t
==============================================================================
--- dbi/trunk/t/09trace.t (original)
+++ dbi/trunk/t/09trace.t Tue Mar 16 02:01:20 2004
@@ -2,20 +2,19 @@
# vim:sw=4:ts=8
use strict;
-use Test::More;
-use DBI;
+use Test::More tests => 66;
-BEGIN { plan tests => 65 }
+BEGIN { use_ok( 'DBI' ); }
$|=1;
# Connect to the example driver.
-ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
+my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
{ PrintError => 0,
RaiseError => 1,
PrintWarn => 1,
- })
-);
+ });
+isa_ok( $dbh, 'DBI::db' );
# Clean up when we're done.
END { $dbh->disconnect if $dbh };
@@ -70,7 +69,8 @@
{
print "inherit\n";
-ok( my $sth = $dbh->prepare("select ctime, name from foo") );
+my $sth = $dbh->prepare("select ctime, name from foo");
+isa_ok( $sth, 'DBI::st' );
is( $sth->{TraceLevel}, $all_flags );
}
Modified: dbi/trunk/t/20meta.t
==============================================================================
--- dbi/trunk/t/20meta.t (original)
+++ dbi/trunk/t/20meta.t Tue Mar 16 02:01:20 2004
@@ -1,20 +1,17 @@
#!../perl -w
-use Test;
-
-BEGIN { plan tests => 6 }
+use Test::More tests => 8;
$|=1;
$^W=1;
-use DBI qw(:sql_types);
-
-use DBI::DBD::Metadata; # just to check for syntax errors etc
+BEGIN { use_ok( 'DBI', ':sql_types' ) }
+BEGIN { use_ok( 'DBI::DBD::Metadata' ) } # just to check for syntax errors etc
$dbh = DBI->connect("dbi:ExampleP:.","","", { FetchHashKeyName => 'NAME_lc' })
or die "Unable to connect to ExampleP driver: $DBI::errstr";
-ok($dbh);
+isa_ok($dbh, 'DBI::db');
#$dbh->trace(3);
#use Data::Dumper;
@@ -25,9 +22,9 @@
my @ti = $dbh->type_info;
ok(@ti>0);
-ok($dbh->type_info(SQL_INTEGER)->{DATA_TYPE}, SQL_INTEGER);
-ok($dbh->type_info(SQL_INTEGER)->{TYPE_NAME}, 'INTEGER');
+is($dbh->type_info(SQL_INTEGER)->{DATA_TYPE}, SQL_INTEGER);
+is($dbh->type_info(SQL_INTEGER)->{TYPE_NAME}, 'INTEGER');
-ok($dbh->type_info(SQL_VARCHAR)->{DATA_TYPE}, SQL_VARCHAR);
-ok($dbh->type_info(SQL_VARCHAR)->{TYPE_NAME}, 'VARCHAR');
+is($dbh->type_info(SQL_VARCHAR)->{DATA_TYPE}, SQL_VARCHAR);
+is($dbh->type_info(SQL_VARCHAR)->{TYPE_NAME}, 'VARCHAR');
Modified: dbi/trunk/t/50dbm.t
==============================================================================
--- dbi/trunk/t/50dbm.t (original)
+++ dbi/trunk/t/50dbm.t Tue Mar 16 02:01:20 2004
@@ -88,7 +88,7 @@
else {
print $dbh->func('dbm_versions');
}
- ok($dbh);
+ isa_ok($dbh, 'DBI::db');
# test if it correctly accepts valid $dbh attributes
#
