Author: capttofu
Date: Wed May 7 04:22:16 2008
New Revision: 11207
Modified:
DBD-mysql/trunk/t/00base.t
DBD-mysql/trunk/t/10connect.t
DBD-mysql/trunk/t/20createdrop.t
DBD-mysql/trunk/t/30insertfetch.t
DBD-mysql/trunk/t/35limit.t
DBD-mysql/trunk/t/35prepare.t
DBD-mysql/trunk/t/40bindparam.t
DBD-mysql/trunk/t/40bindparam2.t
DBD-mysql/trunk/t/40blobs.t
DBD-mysql/trunk/t/40catalog.t
DBD-mysql/trunk/t/40keyinfo.t
DBD-mysql/trunk/t/40listfields.t
DBD-mysql/trunk/t/40nulls.t
DBD-mysql/trunk/t/40numrows.t
DBD-mysql/trunk/t/40types.t
DBD-mysql/trunk/t/41bindparam.t
DBD-mysql/trunk/t/41blobs_prepare.t
DBD-mysql/trunk/t/50chopblanks.t
DBD-mysql/trunk/t/50commit.t
DBD-mysql/trunk/t/60leaks.t
DBD-mysql/trunk/t/lib.pl
DBD-mysql/trunk/t/mysql.dbtest
Log:
Still in the process of converting tests to Test::More
Modified: DBD-mysql/trunk/t/00base.t
==============================================================================
--- DBD-mysql/trunk/t/00base.t (original)
+++ DBD-mysql/trunk/t/00base.t Wed May 7 04:22:16 2008
@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
@@ -6,38 +6,30 @@
# executed as the very first test.
#
+use Test::More tests => 5;
#
# Include lib.pl
#
-our $mdriver = "";
+use vars qw($mdriver $table);
use lib 't', '.';
require 'lib.pl';
-print "Driver is $mdriver\n";
# Base DBD Driver Test
-
-print "1..$tests\n";
-
-require DBI;
-print "ok 1\n";
-
-import DBI;
-print "ok 2\n";
+BEGIN {
+ use_ok( 'DBI' );
+}
$switch = DBI->internal;
-(ref $switch eq 'DBI::dr') ? print "ok 3\n" : print "not ok 3\n";
+cmp_ok ref $switch, 'eq', 'DBI::dr', 'Internal set';
# This is a special case. install_driver should not normally be used.
-$drh = DBI->install_driver($mdriver);
+$drh= DBI->install_driver($mdriver);
-(ref $drh eq 'DBI::dr') ? print "ok 4\n" : print "not ok 4\n";
+ok $drh, 'Install driver';
-if ($drh->{Version}) {
- print "ok 5\n";
- print "Driver version is ", $drh->{Version}, "\n";
-}
+cmp_ok ref $drh, 'eq', 'DBI::dr', 'DBI::dr set';
+
+ok $drh->{Version}, "Version $drh->{Version}";
+print "Driver version is ", $drh->{Version}, "\n";
-BEGIN { $tests = 5 }
-exit 0;
-# end.
Modified: DBD-mysql/trunk/t/10connect.t
==============================================================================
--- DBD-mysql/trunk/t/10connect.t (original)
+++ DBD-mysql/trunk/t/10connect.t Wed May 7 04:22:16 2008
@@ -8,20 +8,19 @@
use vars qw($mdriver);
$|= 1;
-our ($mdriver, $test_dsn, $test_user, $test_password);
-$mdriver = "";
+use vars qw($test_dsn $test_user $test_password);
use lib 't', '.';
require 'lib.pl';
-my @dsn;
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0 });
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-if (! defined $dbh) {
- plan skip_all => "Can't connect to database. Can't continue test";
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr Can't continue test";
}
plan tests => 2;
-ok(defined $dbh, "Connected to database");
+ok defined $dbh, "Connected to database";
-ok($dbh->disconnect());
+ok $dbh->disconnect();
Modified: DBD-mysql/trunk/t/20createdrop.t
==============================================================================
--- DBD-mysql/trunk/t/20createdrop.t (original)
+++ DBD-mysql/trunk/t/20createdrop.t Wed May 7 04:22:16 2008
@@ -7,25 +7,25 @@
use strict;
$|= 1;
-our ($mdriver, $test_dsn, $test_user, $test_password);
+use vars qw($table $test_dsn $test_user $test_password);
use lib 't', '.';
require 'lib.pl';
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0 });
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-if (! defined $dbh) {
- plan skip_all => "Can't obtain driver handle. Can't continue test";
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
plan tests => 4;
ok(defined $dbh, "Connected to database");
-ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean");
+ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
-ok($dbh->do(qq{CREATE TABLE t1 (id INT(4), name VARCHAR(64))}), "creating table");
+ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating $table");
-ok($dbh->do(qq{DROP TABLE t1}), "dropping created table");
+ok($dbh->do("DROP TABLE $table"), "dropping created $table");
$dbh->disconnect();
-
Modified: DBD-mysql/trunk/t/30insertfetch.t
==============================================================================
--- DBD-mysql/trunk/t/30insertfetch.t (original)
+++ DBD-mysql/trunk/t/30insertfetch.t Wed May 7 04:22:16 2008
@@ -1,36 +1,37 @@
#!perl -w
# vim: ft=perl
-use Test::More tests => 9;
+use Test::More;
use DBI;
use DBI::Const::GetInfoType;
+use lib 't', '.';
+require 'lib.pl';
use strict;
$|= 1;
-my $mdriver= "";
-our ($test_dsn, $test_user, $test_password);
-foreach my $file ("lib.pl", "t/lib.pl") {
- do $file;
- if ($@) {
- print STDERR "Error while executing $file: $@\n";
- exit 10;
- }
- last if $mdriver ne '';
+use vars qw($table $test_dsn $test_user $test_password);
+
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
}
+plan tests => 9;
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0 });
ok(defined $dbh, "Connected to database");
-ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean");
+ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
-ok($dbh->do(qq{CREATE TABLE t1 (id INT(4), name VARCHAR(64))}), "creating table");
+ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating table");
-ok($dbh->do("INSERT INTO t1 VALUES(1, 'Alligator Descartes')"), "loading data");
+ok($dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "loading data");
-ok($dbh->do("DELETE FROM t1 WHERE id = 1"), "deleting from table t1");
+ok($dbh->do("DELETE FROM $table WHERE id = 1"), "deleting from table $table");
-my $sth= $dbh->prepare("SELECT * FROM t1 WHERE id = 1");
+my $sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")
+ or die "unable to perform query " . $dbh->errstr;
ok($sth->execute());
@@ -38,8 +39,6 @@
ok($sth->finish());
-ok($dbh->do("DROP TABLE t1"),"Dropping table");
+ok($dbh->do("DROP TABLE $table"),"Dropping table");
$dbh->disconnect();
-
-
Modified: DBD-mysql/trunk/t/35limit.t
==============================================================================
--- DBD-mysql/trunk/t/35limit.t (original)
+++ DBD-mysql/trunk/t/35limit.t Wed May 7 04:22:16 2008
@@ -10,24 +10,26 @@
my $rows = 0;
my $sth;
my $testInsertVals;
-our ($test_dsn, $test_user, $test_password, $mdriver);
-$mdriver='';
+use vars qw($table $test_dsn $test_user $test_password);
use lib 't', '.';
require 'lib.pl';
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0 });
-if (! defined $dbh) {
- plan skip_all => "Can't connect to database ERROR: $DBI::errstr. Can't continue
test";
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
}
plan tests => 111;
+
ok(defined $dbh, "Connected to database");
-ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean");
+ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
-ok($dbh->do(qq{CREATE TABLE t1 (id INT(4), name VARCHAR(64))}), "creating table");
+ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating table");
-ok(($sth = $dbh->prepare("INSERT INTO t1 VALUES (?,?)")));
+ok(($sth = $dbh->prepare("INSERT INTO $table VALUES (?,?)")));
print "PERL testing insertion of values from previous prepare of insert statement:\n";
for (my $i = 0 ; $i < 100; $i++) {
@@ -39,16 +41,8 @@
}
print "PERL rows : " . $rows . "\n";
-#print "PERL testing prepare of select statement with INT and VARCHAR placeholders:\n";
-#ok(($sth = $dbh->prepare("SELECT * FROM t1 WHERE id = ? AND name = ?")));
-
-#for my $id (keys %$testInsertVals) {
-# print "id $id value $testInsertVals->{$id}\n";
-# $sth->execute($id, $testInsertVals->{$id});
-#}
-
print "PERL testing prepare of select statement with LIMIT placeholders:\n";
-ok($sth = $dbh->prepare("SELECT * FROM t1 LIMIT ?, ?"));
+ok($sth = $dbh->prepare("SELECT * FROM $table LIMIT ?, ?"));
print "PERL testing exec of bind vars for LIMIT\n";
ok($sth->execute(20, 50));
@@ -61,9 +55,6 @@
ok($sth->finish);
-#
-# Finally drop the test table.
-#
-ok($dbh->do("DROP TABLE t1"));
+ok($dbh->do("DROP TABLE $table"));
ok($dbh->disconnect);
Modified: DBD-mysql/trunk/t/35prepare.t
==============================================================================
--- DBD-mysql/trunk/t/35prepare.t (original)
+++ DBD-mysql/trunk/t/35prepare.t Wed May 7 04:22:16 2008
@@ -1,29 +1,25 @@
-#!/usr/bin/perl
+#!perl -w
use strict;
-use Test::More tests => 49;
+use Test::More;
use DBI;
use Carp qw(croak);
use Data::Dumper;
-
-$^W =1;
+use lib 't', '.';
+require 'lib.pl';
my ($row, $sth, $dbh);
my ($table, $def, $rows, $errstr, $ret_ref);
-our($test_dsn, $test_user, $test_password, $mdriver);
+use vars qw($table $test_dsn $test_user $test_password);
-$mdriver='';
-foreach my $file ("lib.pl", "t/lib.pl") {
- do $file;
- if ($@) {
- print STDERR "Error while executing $file: $@\n";
- exit 10;
- }
- last if $mdriver ne '';
-}
+eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, AutoCommit => 1});};
-$dbh = DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, AutoCommit => 1});
+if ($@) {
+ plan skip_all =>
+ "Can't connect to database ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 49;
ok(defined $dbh, "Connected to database");
Modified: DBD-mysql/trunk/t/40bindparam.t
==============================================================================
--- DBD-mysql/trunk/t/40bindparam.t (original)
+++ DBD-mysql/trunk/t/40bindparam.t Wed May 7 04:22:16 2008
@@ -1,224 +1,134 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
-# This is a skeleton test. For writing new tests, take this file
-# and modify/extend it.
-#
-
-$^W = 1;
-
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-$sql_mode_feature=1;
+use vars qw($table $test_dsn $test_user $test_password);
-#
-# Include lib.pl
-#
use DBI ();
-use vars qw($COL_NULLABLE);
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($mdriver eq 'pNET') {
- print "1..0\n";
- exit 0;
-}
+use Test::More;
+use lib 't', '.';
+require 'lib.pl';
-sub ServerError() {
- my $err = $DBI::errstr; # Hate -w ...
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-if (!defined(&SQL_VARCHAR)) {
- eval "sub SQL_VARCHAR { 12 }";
-}
-if (!defined(&SQL_INTEGER)) {
- eval "sub SQL_INTEGER { 4 }";
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
-$dbh = DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, AutoCommit => 1}) or ServerError() ;
-$sth= $dbh->prepare("select version()") or
- DbiError($dbh->err, $dbh->errstr);
+$sth= $dbh->prepare("select version()") or
+ die "Unable to select version " . $dbh->errstr;
-$sth->execute() or
- DbiError($dbh->err, $dbh->errstr);
+$sth->execute() or die "Unable to execute select version " . $dbh->errstr;;
-$row= $sth->fetchrow_arrayref() or
- DbiError($dbh->err, $dbh->errstr);
+$row= $sth->fetchrow_arrayref() or
+ die "Unable to select row containing version " . $dbh->errstr;
#
# DROP/CREATE PROCEDURE will give syntax error
# for these versions
#
-if ($row->[0] =~ /^4\.0/ || $row->[0] =~ /^3/)
-{
- $sql_mode_feature= 0;
+if ($row->[0] =~ /^4\.0/ || $row->[0] =~ /^3/) {
+ plan skip_all => "Version of MySQL $row->[0] doesn't support stored
procedures";
}
+plan tests => 38;
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- $table = "t1";
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password, {mysql_enable_utf8 => 1})))
- or ServerError();
-
- Test($state or $sth = $dbh->do("DROP TABLE IF EXISTS $table"))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, $COL_NULLABLE]),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
-
-
-
- Test($state or $sth = $dbh->prepare("INSERT INTO $table"
- . " VALUES (?, ?)"))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Insert some rows
- #
-
- # Automatic type detection
- my $numericVal = 1;
- my $charVal = "Alligator Descartes";
- Test($state or $sth->execute($numericVal, $charVal))
- or DbiError($dbh->err, $dbh->errstr);
-
- # Does the driver remember the automatically detected type?
- Test($state or $sth->execute("3", "Jochen Wiedmann"))
- or DbiError($dbh->err, $dbh->errstr);
- $numericVal = 2;
- $charVal = "Tim Bunce";
- Test($state or $sth->execute($numericVal, $charVal))
- or DbiError($dbh->err, $dbh->errstr);
-
- # Now try the explicit type settings
- Test($state or $sth->bind_param(1, " 4", SQL_INTEGER()))
- or DbiError($dbh->err, $dbh->errstr);
- # umlaut equivelant is vowel followed by 'e'
- Test($state or $sth->bind_param(2, 'Andreas Koenig'))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- # Works undef -> NULL?
- Test($state or $sth->bind_param(1, 5, SQL_INTEGER()))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $sth->bind_param(2, undef))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- # Test binding negative numbers [rt.cpan.org #18976]
- Test($state or $sth->bind_param(1, undef, SQL_INTEGER()))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $sth->bind_param(2, undef))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $sth->execute(-1, "abc"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or undef $sth || 1);
-
- #
- # Try various mixes of question marks, single and double quotes
- #
- Test($state or $dbh->do("INSERT INTO $table VALUES (6, '?')"))
- or DbiError($dbh->err, $dbh->errstr);
- if ($mdriver eq 'mysql' or $mdriver eq 'mysqlEmb') {
- ($state or ! $sql_mode_feature) or $dbh->do('SET @old_sql_mode = @@sql_mode,
@@sql_mode = \'\'');
- Test(($state or !$sql_mode_feature) or ($sql_mode_feature and $dbh->do("INSERT INTO
$table VALUES (7, \"?\")")))
- or DbiError($dbh->err, $dbh->errstr);
- ($state or ! $sql_mode_feature) or ($sql_mode_feature and $dbh->do('SET
@@sql_mode = @old_sql_mode'));
- }
-
- #
- # And now retreive the rows using bind_columns
- #
- Test($state or $sth = $dbh->prepare("SELECT * FROM $table"
- . " ORDER BY id"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->bind_columns(undef, \$id, \$name))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or (($ref = $sth->fetch) && $id == -1 &&
- $name eq 'abc'))
- or print("Query returned id = $id, name = $name, expected -1,abc\n");
-
- Test($state or ($ref = $sth->fetch) && $id == 1 &&
- $name eq 'Alligator Descartes')
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $sth->fetch) && $id == 2 &&
- $name eq 'Tim Bunce'))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $sth->fetch) && $id == 3 &&
- $name eq 'Jochen Wiedmann'))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $sth->fetch) && $id == 4 &&
- $name eq 'Andreas Koenig'))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $sth->fetch) && $id == 5 &&
- !defined($name)))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $sth->fetch) && $id == 6 &&
- $name eq '?'))
- or print("Query returned id = $id, name = $name, expected 6,?\n");
-
- Test(($state || !$sql_mode_feature) or (($ref = $sth->fetch) && $id == 7
&&
- $name eq '?'))
- or print("Query returned id = $id, name = $name, expected 7,?\n");
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
+ok ($dbh->do("DROP TABLE IF EXISTS $table"));
- Test($state or undef $sth or 1);
+my $create = <<EOT;
+CREATE TABLE $table (
+ id int(4) NOT NULL default 0,
+ name varchar(64) default ''
+ )
+EOT
-}
+ok ($dbh->do($create));
+
+$sth = $dbh->prepare("INSERT INTO $table VALUES (?, ?)") or
+ die "Unable to prepare insert " . $dbh->errstr;
+
+ok $sth;
+
+# Automatic type detection
+my $numericVal = 1;
+my $charVal = "Alligator Descartes";
+ok ($sth->execute($numericVal, $charVal));
+
+# Does the driver remember the automatically detected type?
+ok ($sth->execute("3", "Jochen Wiedmann"));
+
+$numericVal = 2;
+$charVal = "Tim Bunce";
+ok ($sth->execute($numericVal, $charVal));
+
+# Now try the explicit type settings
+ok ($sth->bind_param(1, " 4", SQL_INTEGER()));
+
+# umlaut equivelant is vowel followed by 'e'
+ok ($sth->bind_param(2, 'Andreas Koenig'));
+ok ($sth->execute);
+
+# Works undef -> NULL?
+ok ($sth->bind_param(1, 5, SQL_INTEGER()));
+
+ok ($sth->bind_param(2, undef));
+
+ok ($sth->execute);
+
+ok ($sth->bind_param(1, undef, SQL_INTEGER()));
+
+ok ($sth->bind_param(2, undef));
+
+ok ($sth->execute(-1, "abc"));
+
+ok ($dbh->do("INSERT INTO $table VALUES (6, '?')"));
+
+ok ($dbh->do('SET @old_sql_mode = @@sql_mode, @@sql_mode = \'\''));
+
+ok ($dbh->do("INSERT INTO $table VALUES (7, \"?\")"));
+
+ok ($dbh->do('SET @@sql_mode = @old_sql_mode'));
+
+$sth = $dbh->prepare("SELECT * FROM $table ORDER BY id") or die "Unable to prepare " .
$dbh->errstr;
+
+ok($sth->execute);
+
+ok ($sth->bind_columns(undef, \$id, \$name));
+
+$ref = $sth->fetch ;
+
+cmp_ok $id, '==', -1, 'id set to -1';
+
+cmp_ok $name, 'eq', 'abc', 'name eq abc';
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 1, 'id set to 1';
+cmp_ok $name, 'eq', 'Alligator Descartes', '$name set to Alligator Descartes';
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 2, 'id set to 2';
+cmp_ok $name, 'eq', 'Tim Bunce', '$name set to Tim Bunce';
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 3, 'id set to 3';
+cmp_ok $name, 'eq', 'Jochen Wiedmann', '$name set to Jochen Wiedmann';
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 4, 'id set to 4';
+cmp_ok $name, 'eq', 'Andreas Koenig', '$name set to Andreas Koenig';
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 5, 'id set to 5';
+ok !defined($name), 'name not defined';
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 6, 'id set to 6';
+cmp_ok $name, 'eq', '?', "\$name set to '?'";
+
+$ref = $sth->fetch;
+cmp_ok $id, '==', 7, '$id set to 7';
+cmp_ok $name, 'eq', '?', "\$name set to '?'";
+
+ok ($dbh->do("DROP TABLE $table"));
Modified: DBD-mysql/trunk/t/40bindparam2.t
==============================================================================
--- DBD-mysql/trunk/t/40bindparam2.t (original)
+++ DBD-mysql/trunk/t/40bindparam2.t Wed May 7 04:22:16 2008
@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id: 40bindparam.t 6304 2006-05-17 21:23:10Z capttofu $
#
@@ -6,110 +6,51 @@
# and modify/extend it.
#
-$^W = 1;
+use Test::More;
+use DBI ();
+use vars qw($table $test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
+my $dbh;
+eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, AutoCommit => 1}) or ServerError();};
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 10;
-#
-# Include lib.pl
-#
-use DBI ();
-use vars qw($COL_NULLABLE $rows);
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($mdriver eq 'pNET') {
- print "1..0\n";
- exit 0;
-}
-
-sub ServerError() {
- my $err = $DBI::errstr; # Hate -w ...
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-if (!defined(&SQL_VARCHAR)) {
- eval "sub SQL_VARCHAR { 12 }";
-}
-if (!defined(&SQL_INTEGER)) {
- eval "sub SQL_INTEGER { 4 }";
-}
+ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table $table";
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- Test($state or
- ($dbh->do("CREATE TABLE t1 (id INT NOT NULL AUTO_INCREMENT PRIMARY KEY, num
INT)")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($dbh->do("INSERT INTO t1 VALUES(NULL, 1)")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($rows= $dbh->selectall_arrayref("SELECT * FROM t1")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($rows->[0][1] == 1))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or
- ($sth = $dbh->prepare("UPDATE t1 SET num = ? WHERE id = ?")))
- or DbiError($dbh->err, $dbh->errstr);
+my $create= <<EOT;
+CREATE TABLE $table (
+ id INT NOT NULL AUTO_INCREMENT PRIMARY KEY,
+ num INT(3))
+EOT
- Test($state or ($sth->bind_param(2, 1, SQL_INTEGER())))
- or DbiError($dbh->err, $dbh->errstr);
+ok $dbh->do($create), "create table $table";
+
+ok $dbh->do("INSERT INTO $table VALUES(NULL, 1)"), "insert into $table (null, 1)";
+
+my $rows;
+$rows= $dbh->selectall_arrayref("SELECT * FROM $table") or die "select * from $table
failed " . $dbh->errstr;
+
+cmp_ok $rows->[0][1], '==', 1, "\$rows->[0][1] == 1";
+
+$sth = $dbh->prepare("UPDATE $table SET num = ? WHERE id = ?") or die "Unable to
update $table " . $dbh->errstr;
+
+ok ($sth->bind_param(2, 1, SQL_INTEGER()));
- Test($state or ($sth->execute()))
- or DbiError($dbh->err, $dbh->errstr);
+ok ($sth->execute());
+
+ok ($sth->finish());
+
+$rows = $dbh->selectall_arrayref("SELECT * FROM $table") or die "select failed " .
$dbh->errstr;
- Test($state or ($sth->finish()))
- or DbiError($dbh->err, $dbh->errstr);
+ok !defined($rows->[0][1]);
- Test($state or
- ($rows = $dbh->selectall_arrayref("SELECT * FROM t1")))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # in this case, it should be NULL
- #
- Test($state or (! defined $rows->[0][1]))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE t1"))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # disconnect
- #
- Test($state or ($dbh->disconnect()))
- or DbiError($dbh->err, $dbh->errstr);
+ok ($dbh->do("DROP TABLE $table"));
-}
+ok ($dbh->disconnect());
Modified: DBD-mysql/trunk/t/40blobs.t
==============================================================================
--- DBD-mysql/trunk/t/40blobs.t (original)
+++ DBD-mysql/trunk/t/40blobs.t Wed May 7 04:22:16 2008
@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
@@ -7,138 +7,76 @@
#
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
+use DBI ();
+use Test::More;
+use vars qw($table $test_dsn $test_user $test_password);
+use lib '.', 't';
+require 'lib.pl';
-#
-# Include lib.pl
-#
-require DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
+sub ShowBlob($) {
+ my ($blob) = @_;
+ for ($i = 0; $i < 8; $i++) {
+ if (defined($blob) && length($blob) > $i) {
+ $b = substr($blob, $i*32);
+ }
+ else {
+ $b = "";
+ }
+ printf("%08lx %s\n", $i*32, unpack("H64", $b));
}
}
-sub ServerError() {
- my $err = $DBI::errstr; # Hate -w ...
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+my $dbh;
+eval {$dbh = DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, AutoCommit => 1}) or ServerError() ;};
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 12;
-sub ShowBlob($) {
- my ($blob) = @_;
- for($i = 0; $i < 8; $i++) {
- if (defined($blob) && length($blob) > $i) {
- $b = substr($blob, $i*32);
- } else {
- $b = "";
- }
- printf("%08lx %s\n", $i*32, unpack("H64", $b));
- }
+my $size= 128;
+ok $dbh->do("DROP TABLE IF EXISTS $table"), "Drop table if exists $table";
+my $create = <<EOT;
+CREATE TABLE $table (
+ id INT(3) NOT NULL DEFAULT 0,
+ name BLOB ) DEFAULT CHARSET=utf8
+EOT
+
+ok ($dbh->do($create));
+
+my ($blob, $qblob) = "";
+my $b = "";
+for ($j = 0; $j < 256; $j++) {
+ $b .= chr($j);
}
+for ($i = 0; $i < $size; $i++) {
+ $blob .= $b;
+}
+$qblob = $dbh->quote($blob);
+ok $qblob, 'Blob properly quoted';
+# Insert a row into the test table.......
+my ($query);
+$query = "INSERT INTO $table VALUES(1, $qblob)";
+ok ($dbh->do($query));
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- my($def);
- my $table='t1';
- foreach $size (128) {
-
- Test($state or $dbh->do("DROP TABLE IF EXISTS $table"))
- or DbiError($dbh->err, $dbh->errstr);
- #
- # Create a new table
- #
- if (!$state) {
- $def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "BLOB", $size, 0]);
- print "Creating table:\n$def\n";
- }
- Test($state or $dbh->do($def))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # Create a blob
- #
- my ($blob, $qblob) = "";
- if (!$state) {
- my $b = "";
- for ($j = 0; $j < 256; $j++) {
- $b .= chr($j);
- }
- for ($i = 0; $i < $size; $i++) {
- $blob .= $b;
- }
- $qblob = $dbh->quote($blob);
- }
-
- #
- # Insert a row into the test table.......
- #
- my($query);
- if (!$state) {
- $query = "INSERT INTO $table VALUES(1, $qblob)";
- if ($ENV{'SHOW_BLOBS'} && open(OUT, ">" . $ENV{'SHOW_BLOBS'})) {
- print OUT $query;
- close(OUT);
- }
- }
- Test($state or $dbh->do($query))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Now, try SELECT'ing the row out.
- #
- Test($state or $sth = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id = 1"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or (defined($row = $sth->fetchrow_arrayref)))
- or DbiError($sth->err, $sth->errstr);
-
- Test($state or (@$row == 2 && $$row[0] == 1 && $$row[1] eq $blob))
- or (ShowBlob($blob),
- ShowBlob(defined($$row[1]) ? $$row[1] : ""));
-
- Test($state or $sth->finish)
- or DbiError($sth->err, $sth->errstr);
-
- Test($state or undef $sth || 1)
- or DbiError($sth->err, $sth->errstr);
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
- }
-}
+# Now, try SELECT'ing the row out.
+$sth = $dbh->prepare("SELECT * FROM $table WHERE id = 1")
+ or die "unable to query $table " . $dbh->errstr;
+
+ok $sth, "prepare of query of $table succeeded";
+ok ($sth->execute);
+
+$row = $sth->fetchrow_arrayref or die "Unable to select row from query";
+ok defined($row), "row returned defined";
+
+cmp_ok @$row, '==', 2, "records from $table returned 2";
+cmp_ok $$row[0], '==', 1, 'id set to 1';
+cmp_ok byte_string($$row[1]), 'eq', byte_string($blob), 'blob set equal to blob
returned';
+
+ShowBlob($blob), ShowBlob(defined($$row[1]) ? $$row[1] : "");
+
+ok ($sth->finish);
+
+ok $dbh->do("DROP TABLE $table"), "Drop table $table";
Modified: DBD-mysql/trunk/t/40catalog.t
==============================================================================
--- DBD-mysql/trunk/t/40catalog.t (original)
+++ DBD-mysql/trunk/t/40catalog.t Wed May 7 04:22:16 2008
@@ -5,27 +5,23 @@
use Test::More;
use DBI;
use DBI::Const::GetInfoType;
+use lib '.', 't';
+require 'lib.pl';
use strict;
$|= 1;
-my $mdriver= "";
+use vars qw($table $test_dsn $test_user $test_password);
-our ($test_dsn, $test_user, $test_password);
-foreach my $file ("lib.pl", "t/lib.pl") {
- do $file;
- if ($@) {
- print STDERR "Error while executing $file: $@\n";
- exit 10;
- }
- last if $mdriver ne '';
-}
-
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
{ RaiseError => 1,
PrintError => 1,
AutoCommit => 0,
- mysql_server_prepare => 0 });
+ mysql_server_prepare => 0 });};
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
+}
plan tests => 77;
ok(defined $dbh, "connecting");
Modified: DBD-mysql/trunk/t/40keyinfo.t
==============================================================================
--- DBD-mysql/trunk/t/40keyinfo.t (original)
+++ DBD-mysql/trunk/t/40keyinfo.t Wed May 7 04:22:16 2008
@@ -1,52 +1,48 @@
#!perl -w
# vim: ft=perl
-use Test::More tests => 7;
+use Test::More;
use DBI;
use strict;
+use lib 't', '.';
+require 'lib.pl';
$|= 1;
-my $mdriver= "";
-our ($test_dsn, $test_user, $test_password);
-foreach my $file ("lib.pl", "t/lib.pl") {
- do $file;
- if ($@) {
- print STDERR "Error while executing $file: $@\n";
- exit 10;
- }
- last if $mdriver ne '';
-}
+use vars qw($table $test_dsn $test_user $test_password);
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0 });
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 7;
$dbh->{mysql_server_prepare}= 0;
-
ok(defined $dbh, "Connected to database for key info tests");
-ok($dbh->do(qq{DROP TABLE IF EXISTS t1}),
- "Dropped table");
+ok($dbh->do("DROP TABLE IF EXISTS $table"), "Dropped table");
# Non-primary key is there as a regression test for Bug #26786.
-ok($dbh->do(qq{CREATE TABLE t1 (a int, b varchar(20), c int,
- primary key (a,b(10)), key (c))}),
- "Created table");
+ok($dbh->do("CREATE TABLE $table (a int, b varchar(20), c int,
+ primary key (a,b(10)), key (c))"),
+ "Created table $table");
-my $sth= $dbh->primary_key_info(undef, undef, 't1');
+my $sth= $dbh->primary_key_info(undef, undef, $table);
ok($sth, "Got primary key info");
my $key_info= $sth->fetchall_arrayref;
my $expect= [
- [ undef, undef, 't1', 'a', '1', 'PRIMARY' ],
- [ undef, undef, 't1', 'b', '2', 'PRIMARY' ],
+ [ undef, undef, $table, 'a', '1', 'PRIMARY' ],
+ [ undef, undef, $table, 'b', '2', 'PRIMARY' ],
];
is_deeply($key_info, $expect, "Check primary_key_info results");
-is_deeply([ $dbh->primary_key(undef, undef, 't1') ], [ 'a', 'b' ],
+is_deeply([ $dbh->primary_key(undef, undef, $table) ], [ 'a', 'b' ],
"Check primary_key results");
-ok($dbh->do(qq{DROP TABLE t1}), "Dropped table");
+ok($dbh->do("DROP TABLE $table"), "Dropped table");
$dbh->disconnect();
Modified: DBD-mysql/trunk/t/40listfields.t
==============================================================================
--- DBD-mysql/trunk/t/40listfields.t (original)
+++ DBD-mysql/trunk/t/40listfields.t Wed May 7 04:22:16 2008
@@ -1,4 +1,5 @@
-#!/usr/local/bin/perl
+#!perl -w
+# vim: ft=perl
#
# $Id$
#
@@ -7,157 +8,100 @@
#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-$COL_KEY = '';
-
-
-#
# Include lib.pl
#
+
use DBI;
+use Test::More;
use vars qw($verbose);
+use lib '.', 't';
+require 'lib.pl';
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
+use vars qw($test_dsn $test_user $test_password);
+my $quoted;
+my $create;
-@table_def = (
- ["id", "INTEGER", 4, $COL_KEY],
- ["name", "CHAR", 64, $COL_NULLABLE]
- );
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- $dbh->{mysql_server_prepare}= 0;
-
- #
- # We use a hardcoded special table name to test for a regression of
- # http://bugs.mysql.com/22005
- #
- $table= 't1$special';
- $state or $dbh->do("DROP TABLE IF EXISTS `$table`" );
-
- #
- # Create a new table
- #
- Test($state or ($def = TableDefinition($table, @table_def),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $dbh->table_info(undef,undef,$table));
- Test($state or $dbh->column_info(undef,undef,$table,'%'));
-
- #
- # Bug #23974: "column_info does not return error when table does not exist"
- # DBI spec specifies that empty ref should be returned, not error
- #
- Test($state or
- ($sth= $dbh->column_info(undef,undef,"this_does_not_exist",'%')));
-
- Test($sth and ! $sth->err());
-
- Test($state or $sth = $dbh->prepare("SELECT * FROM $table"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->execute)
- or DbiError($sth->err, $sth->errstr);
-
- my $res;
- Test($state or (($res = $sth->{'NUM_OF_FIELDS'}) == @table_def))
- or DbiError($sth->err, $sth->errstr);
- if (!$state && $verbose) {
- printf("Number of fields: %s\n", defined($res) ? $res : "undef");
- }
-
- Test($state or ($ref = $sth->{'NAME'}) && @$ref == @table_def
- && (lc $$ref[0]) eq $table_def[0][0]
- && (lc $$ref[1]) eq $table_def[1][0])
- or DbiError($sth->err, $sth->errstr);
- if (!$state && $verbose) {
- print "Names:\n";
- for ($i = 0; $i < @$ref; $i++) {
- print " ", $$ref[$i], "\n";
- }
- }
-
- Test($state or ($ref = $sth->{'NULLABLE'}) && @$ref == @table_def
- && !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
- && !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
- or DbiError($sth->err, $sth->errstr);
- if (!$state && $verbose) {
- print "Nullable:\n";
- for ($i = 0; $i < @$ref; $i++) {
- print " ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
- }
- }
-
- Test($state or (($ref = $sth->{TYPE}) && (@$ref == @table_def)
- && ($ref->[0] eq DBI::SQL_INTEGER())
- && ($ref->[1] eq DBI::SQL_VARCHAR() ||
- $ref->[1] eq DBI::SQL_CHAR())))
- or printf("Expected types %d and %d, got %s and %s\n",
- &DBI::SQL_INTEGER(), &DBI::SQL_VARCHAR(),
- defined($ref->[0]) ? $ref->[0] : "undef",
- defined($ref->[1]) ? $ref->[1] : "undef");
-
- Test($state or undef $sth || 1);
-
-
- #
- # Drop the test table
- #
- Test($state or ($sth = $dbh->prepare("DROP TABLE $table")))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $sth->execute)
- or DbiError($sth->err, $sth->errstr);
-
- # NUM_OF_FIELDS should be zero (Non-Select)
- Test($state or (! defined $sth->{'NUM_OF_FIELDS'} ||
- $sth->{'NUM_OF_FIELDS'} == 0))
- or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
- $sth->{'NUM_OF_FIELDS'});
- Test($state or (undef $sth) or 1);
-
- #
- # Test different flavours of quote. Need to work around a bug in
- # DBI 1.02 ...
- #
- my $quoted;
- if (!$state) {
- $quoted = eval { $dbh->quote(0, DBI::SQL_INTEGER()) };
- }
- Test($state or $@ or $quoted eq 0);
- if (!$state) {
- $quoted = eval { $dbh->quote('abc', DBI::SQL_VARCHAR()) };
- }
- Test($state or $@ or $quoted eq q{'abc'});
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
+plan tests => 24;
+
+$dbh->{mysql_server_prepare}= 0;
+
+ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
+
+$create = <<EOC;
+CREATE TABLE $table (
+ id INT(4) NOT NULL,
+ name VARCHAR(64),
+ key id (id)
+ )
+EOC
+
+ok $dbh->do($create), "create table $table";
+
+ok $dbh->table_info(undef,undef,$table), "table info for $table";
+
+ok $dbh->column_info(undef,undef,$table,'%'), "column_info for $table";
+
+$sth= $dbh->column_info(undef,undef,"this_does_not_exist",'%');
+
+ok $sth, "\$sth defined";
+ok !$sth->err(), "not error";
+
+$sth = $dbh->prepare("SELECT * FROM $table");
+
+ok $sth, "prepare succeeded";
+
+ok $sth->execute, "execute select";
+
+my $res;
+$res = $sth->{'NUM_OF_FIELDS'};
+
+ok $res, "$sth->{NUM_OF_FIELDS} defined";
+
+cmp_ok $res, '==', 2, "\$res $res == 2";
+
+$ref = $sth->{'NAME'};
+
+ok $ref, "\$sth->{NAME} defined";
+
+cmp_ok $$ref[0], 'eq', 'id', "$$ref[0] eq 'id'";
+
+cmp_ok $$ref[1], 'eq', 'name', "$$ref[1] eq 'name'";
+
+$ref = $sth->{'NULLABLE'};
+
+ok $ref, "nullable";
+
+ok !($$ref[0] xor (0 & $COL_NULLABLE));
+ok !($$ref[1] xor (1 & $COL_NULLABLE));
+
+$ref = $sth->{TYPE};
+
+cmp_ok $ref->[0], 'eq', DBI::SQL_INTEGER(), "SQL_INTEGER";
+
+cmp_ok $ref->[1], 'eq', DBI::SQL_VARCHAR(), "SQL_VARCHAR";
+
+$sth= $dbh->prepare("DROP TABLE $table") or die "$DBI::errstr";
+
+ok($sth->execute);
+
+ok (! defined $sth->{'NUM_OF_FIELDS'});
+
+$quoted = eval { $dbh->quote(0, DBI::SQL_INTEGER()) };
+
+ok (!$@);
+
+cmp_ok $quoted, 'eq', '0', "equals '0'";
+
+$quoted = eval { $dbh->quote('abc', DBI::SQL_VARCHAR()) };
+
+ok (!$@);
+
+cmp_ok $quoted, 'eq', "\'abc\'", "equals 'abc'";
Modified: DBD-mysql/trunk/t/40nulls.t
==============================================================================
--- DBD-mysql/trunk/t/40nulls.t (original)
+++ DBD-mysql/trunk/t/40nulls.t Wed May 7 04:22:16 2008
@@ -1,99 +1,51 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
# This is a test for correctly handling NULL values.
#
+use strict;
+use DBI;
+use Test::More;
+use Carp qw(croak);
+use Data::Dumper;
+use vars qw($table $test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
+
+my ($dbh, $sth);
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 8;
+ok $dbh->do("DROP TABLE IF EXISTS $table"), "DROP TABLE IF EXISTS $table";
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
+my $create= <<EOT;
+CREATE TABLE $table (
+ id INT(4),
+ name VARCHAR(64)
+ )
+EOT
+ok $dbh->do($create), "create table $create";
+ok $dbh->do("INSERT INTO $table VALUES ( NULL, 'NULL-valued id' )"), "inserting
nulls";
-#
-# Include lib.pl
-#
-use DBI;
-use vars qw($COL_NULLABLE);
+$sth = $dbh->prepare("SELECT * FROM $table WHERE id IS NULL") or die "$DBI::errstr";
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
+do $sth->execute;
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+my $aref = $sth->fetchrow_arrayref or die "$DBI::errstr";
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- $table= t1;
-
- Test($state or $dbh->do("DROP TABLE IF EXISTS $table"))
- or DbiError($dbh->err, $dbh->errstr);
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, $COL_NULLABLE],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # Test whether or not a field containing a NULL is returned correctly
- # as undef, or something much more bizarre
- #
- Test($state or $dbh->do("INSERT INTO $table VALUES"
- . " ( NULL, 'NULL-valued id' )"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth = $dbh->prepare("SELECT * FROM $table"
- . " WHERE " . IsNull("id")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($rv = $sth->fetchrow_arrayref) or $dbdriver eq 'CSV')
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or (!defined($$rv[0]) and defined($$rv[1])) or
- $dbdriver eq 'CSV')
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth->finish)
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
+ok !defined($$aref[0]);
- Test($state or undef $sth || 1);
-}
+ok defined($$aref[1]);
+
+ok $sth->finish;
+
+ok $dbh->do("DROP TABLE $table");
+
+ok $dbh->disconnect;
Modified: DBD-mysql/trunk/t/40numrows.t
==============================================================================
--- DBD-mysql/trunk/t/40numrows.t (original)
+++ DBD-mysql/trunk/t/40numrows.t Wed May 7 04:22:16 2008
@@ -1,156 +1,90 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
# This tests, whether the number of rows can be retrieved.
#
-
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
+use strict;
use DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl", "DBD-mysql/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
+use Test::More;
+use Carp qw(croak);
+use Data::Dumper;
+use vars qw($table $test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
+
+my ($dbh, $sth, $aref);
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
}
+plan tests => 22;
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+ok $dbh->do("DROP TABLE IF EXISTS $table");
+my $create= <<EOT;
+CREATE TABLE $table (
+ id INT(4) NOT NULL DEFAULT 0,
+ name varchar(64) NOT NULL DEFAULT ''
+)
+EOT
-sub TrueRows($) {
- my ($sth) = @_;
- my $count = 0;
- while ($sth->fetchrow_arrayref) {
- ++$count;
- }
- $count;
-}
+ok $dbh->do($create), "CREATE TABLE $table";
+ok $dbh->do("INSERT INTO $table VALUES( 1, 'Alligator Descartes' )"), 'inserting first
row';
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ServerError();
+$sth = $dbh->prepare("SELECT * FROM $table WHERE id = 1") or die "$DBI::errstr";
- $table= 't1';
+ok $sth->execute;
- Test($state or $dbh->do("DROP TABLE IF EXISTS $table"))
- or DbiError($dbh->err, $dbh->errstr);
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok $sth->rows, '==', 1, '\$sth->rows should be 1';
+$aref= $sth->fetchall_arrayref or die "$DBI::errstr";
- #
- # This section should exercise the sth->rows
- # method by preparing a statement, then finding the
- # number of rows within it.
- # Prior to execution, this should fail. After execution, the
- # number of rows affected by the statement will be returned.
- #
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES( 1, 'Alligator Descartes' )"))
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok scalar @$aref, '==', 1, 'Verified rows should be 1';
- Test($state or ($sth = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id = 1")))
- or DbiError($dbh->err, $dbh->errstr);
+ok $sth->finish;
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
+ok $dbh->do("INSERT INTO $table VALUES( 2, 'Jochen Wiedmann' )"), 'inserting second
row';
- Test($state or ($numrows = $sth->rows) == 1 or ($numrows == -1))
- or ErrMsgF("Expected 1 rows, got %s.\n", $numrows);
+$sth = $dbh->prepare("SELECT * FROM $table WHERE id >= 1") or die "$DBI::errstr";
- Test($state or ($numrows = TrueRows($sth)) == 1)
- or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);
+ok $sth->execute;
- Test($state or $sth->finish)
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok $sth->rows, '==', 2, '\$sth->rows should be 2';
- Test($state or undef $sth or 1);
+$aref= $sth->fetchall_arrayref or die "$DBI::errstr";
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES( 2, 'Jochen Wiedmann' )"))
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok scalar @$aref, '==', 2, 'Verified rows should be 2';
- Test($state or ($sth = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id >= 1")))
- or DbiError($dbh->err, $dbh->errstr);
+ok $sth->finish;
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
+ok $dbh->do("INSERT INTO $table VALUES(3, 'Tim Bunce')"), "inserting third row";
- Test($state or ($numrows = $sth->rows) == 2 or ($numrows == -1))
- or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);
+$sth = $dbh->prepare("SELECT * FROM $table WHERE id >= 2") or die "$DBI::errstr";
- Test($state or ($numrows = TrueRows($sth)) == 2)
- or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
+ok $sth->execute;
- Test($state or $sth->finish)
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok $sth->rows, '==', 2, 'rows should be 2';
- Test($state or undef $sth or 1);
+$aref= $sth->fetchall_arrayref or die "$DBI::errstr";
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES(3, 'Tim Bunce')"))
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok scalar @$aref, '==', 2, 'Verified rows should be 2';
- Test($state or ($sth = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id >= 2")))
- or DbiError($dbh->err, $dbh->errstr);
+ok $sth->finish;
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
+$sth = $dbh->prepare("SELECT * FROM $table") or die "$DBI::errstr";
- Test($state or ($numrows = $sth->rows) == 2 or ($numrows == -1))
- or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);
+ok $sth->execute;
- Test($state or ($numrows = TrueRows($sth)) == 2)
- or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
+cmp_ok $sth->rows, '==', 3, 'rows should be 3';
- Test($state or $sth->finish)
- or DbiError($dbh->err, $dbh->errstr);
+$aref= $sth->fetchall_arrayref or die "$DBI::errstr";
- Test($state or undef $sth or 1);
+cmp_ok scalar @$aref, '==', 3, 'Verified rows should be 3';
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
+ok $dbh->do("DROP TABLE $table"), "drop table $table";
-}
+ok $dbh->disconnect;
Modified: DBD-mysql/trunk/t/40types.t
==============================================================================
--- DBD-mysql/trunk/t/40types.t (original)
+++ DBD-mysql/trunk/t/40types.t Wed May 7 04:22:16 2008
@@ -4,29 +4,24 @@
use Test::More;
use DBI;
use DBI::Const::GetInfoType;
+use lib '.', 't';
+require 'lib.pl';
use strict;
$|= 1;
-my $mdriver= "";
+use vars qw($table $test_dsn $test_user $test_password);
-our ($test_dsn, $test_user, $test_password);
-foreach my $file ("lib.pl", "t/lib.pl") {
- do $file;
- if ($@) {
- print STDERR "Error while executing $file: $@\n";
- exit 10;
- }
- last if $mdriver ne '';
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+print "err perl $@\n";
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
}
-
-my $dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1,
- PrintError => 1,
- AutoCommit => 0,
- mysql_server_prepare => 0 });
plan tests => 20;
-ok(defined $dbh, "connecting");
+ok(defined $dbh, "Connected to database");
SKIP: {
skip "New Data types not supported by server", 19
Modified: DBD-mysql/trunk/t/41bindparam.t
==============================================================================
--- DBD-mysql/trunk/t/41bindparam.t (original)
+++ DBD-mysql/trunk/t/41bindparam.t Wed May 7 04:22:16 2008
@@ -1,76 +1,42 @@
-#!/usr/bin/perl
+#!perl -w
use strict;
-use vars qw($test_dsn $test_user $test_password $mdriver $state);
use DBI;
+use Test::More;
use Carp qw(croak);
use Data::Dumper;
+use vars qw($table $test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
+
+my ($dbh, $sth);
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 9;
-$^W =1;
+my ($rows, $errstr, $ret_ref);
+ok $dbh->do("drop table if exists $table"), "drop table $table";
+ok $dbh->do("create table $table (a int not null, primary key (a))"), "create table
$table";
-use DBI;
-$mdriver = "";
-my ($row, $sth, $dbh);
-foreach my $file ("lib.pl", "t/lib.pl", "DBD-mysql/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
+$sth= $dbh->prepare("insert into $table values (?)") or die "$DBI::errstr";
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+ok $sth->bind_param(1,10000,DBI::SQL_INTEGER), "bind param 10000 col1";
-while(Testing())
-{
- my ($table, $def, $rows, $errstr, $ret_ref);
- Test($state or $dbh =
- DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, AutoCommit => 1})) or ServerError() ;
-
- $table= 't1';
- Test($state or $dbh->do("drop table if exists $table")) or
- DbiError($dbh->err, $dbh->errstr);
-
- Test($state or
- $dbh->do("create table $table (a int not null, primary key (a))")) or
- DbiError($dbh->err, $dbh->errstr);
-
- Test($state or
- $sth= $dbh->prepare("insert into $table values (?)")) or
- DbiError($dbh->err, $dbh->errstr);
-
- Test($state or
- $sth->bind_param(1,10000,DBI::SQL_INTEGER)) or
- DbiError($dbh->err, $dbh->errstr);
-
- Test($state or
- $sth->execute()) or
- DbiError($dbh->err, $dbh->errstr);
-
- Test($state or
- $sth->bind_param(1,10001,DBI::SQL_INTEGER)) or
- DbiError($dbh->err, $dbh->errstr);
+ok $sth->execute(), 'execute';
+
+ok $sth->bind_param(1,10001,DBI::SQL_INTEGER), "bind param 10001 col1";
- Test ($state or
- $sth->execute()) or
- DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $sth=
- $dbh->prepare("DROP TABLE $table")) or
- DbiError($dbh->err, $dbh->errstr);
+ok $sth->execute(), 'execute';
- Test($state or $sth->execute()) or
- DbiError($dbh->err, $dbh->errstr);
+$sth= $dbh->prepare("DROP TABLE $table") or die "DBI::errstr";
-}
+ok $sth->execute();
+
+ok $sth->finish;
+
+ok $dbh->disconnect;
Modified: DBD-mysql/trunk/t/41blobs_prepare.t
==============================================================================
--- DBD-mysql/trunk/t/41blobs_prepare.t (original)
+++ DBD-mysql/trunk/t/41blobs_prepare.t Wed May 7 04:22:16 2008
@@ -1,6 +1,6 @@
-#!/usr/local/bin/perl
+#!perl
#
-# $Id: 40blobs.t 1103 2003-03-18 02:53:28Z rlippan $
+# $Id: 40blobs.t 1103 2008-04-29 02:53:28Z capttofu $
#
# This is a test for correct handling of BLOBS; namely $dbh->quote
# is expected to work correctly.
@@ -11,157 +11,96 @@
# which he kindly sent code that this test uses!
#
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
+use strict;
+use DBI;
+use Test::More;
-
-#
-# Include lib.pl
-#
-require DBI;
-$mdriver = "";
my $update_blob;
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
+use vars qw($table $test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
+
+my ($dbh, $row);
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
+plan tests => 19;
my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
my $blob1= join '', map { $chars[rand @chars] } 0 .. 10000;
-$blob2 = '"' x 10000;
-
-sub ServerError() {
- my $err = $DBI::errstr; # Hate -w ...
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
+my $blob2 = '"' x 10000;
sub ShowBlob($) {
- my ($blob) = @_;
- for($i = 0; $i < 8; $i++) {
- if (defined($blob) && length($blob) > $i) {
- $b = substr($blob, $i*32);
- } else {
- $b = "";
- }
- printf("%08lx %s\n", $i*32, unpack("H64", $b));
+ my ($blob) = @_;
+ my $b;
+ for(my $i = 0; $i < 8; $i++) {
+ if (defined($blob) && length($blob) > $i) {
+ $b = substr($blob, $i*32);
+ }
+ else {
+ $b = "";
}
+ printf("%08lx %s\n", $i*32, unpack("H64", $b));
+ }
}
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
-#
-# Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- $table= 't1';
- Test($state or
- $dbh->do("DROP TABLE IF EXISTS $table"))
- or DbiError($dbh->err, $dbh->errstr);
-#
-# create a new table
-#
- Test($state or
- $dbh->do("CREATE TABLE $table (id int(4), name text)"))
- or DbiError($dbh->err, $dbh->errstr);
+my $create = <<EOT;
+CREATE TABLE $table (
+ id int(4),
+ name text)
+EOT
- my($def);
+ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
-#
-# Insert a row into the test table.......
-#
- my($query, $sth);
- if (!$state) {
- $query = "INSERT INTO $table VALUES(?, ?)";
- }
- Test($state or $sth= $dbh->prepare($query))
- or DbiError($dbh->err, $dbh->errstr);
+ok $dbh->do($create), "create table $table";
- Test($state or $sth->execute(1, $blob1))
- or DbiError($dbh->err, $dbh->errstr);
+my $query = "INSERT INTO $table VALUES(?, ?)";
- Test($state or $sth->finish)
- or DbiError($sth->err, $sth->errstr);
+my $sth= $dbh->prepare($query) or die "$DBI::errstr";
- Test($state or undef $sth || 1)
- or DbiError($sth->err, $sth->errstr);
+ok defined($sth);
-#
-# Now, try SELECTing the row out.
-#
- Test($state or $sth=
- $dbh->prepare("SELECT * FROM $table WHERE id = 1"))
- or DbiError($dbh->err, $dbh->errstr);
+ok $sth->execute(1, $blob1), "inserting \$blob1";
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
+ok $sth->finish;
- Test($state or (defined($row = $sth->fetchrow_arrayref)))
- or DbiError($sth->err, $sth->errstr);
+$sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1") or
+ die "$DBI::errstr";
- Test($state or (@$row == 2 && $$row[0] == 1 && $$row[1] eq $blob1))
- or (ShowBlob($blob1),
- ShowBlob(defined($$row[1]) ? $$row[1] : ""));
+ok $sth->execute, "select from $table";
- Test($state or $sth->finish)
- or DbiError($sth->err, $sth->errstr);
+$row = $sth->fetchrow_arrayref or die "$DBI::errstr";
- Test($state or undef $sth || 1)
- or DbiError($sth->err, $sth->errstr);
+cmp_ok @$row, '==', 2, "two rows fetched";
- Test($state or $sth=
- $dbh->prepare("UPDATE $table SET name = ? WHERE id = 1"))
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok $$row[0], '==', 1, "first row id == 1";
- Test($state or $sth->execute($blob2))
- or DbiError($dbh->err, $dbh->errstr);
+cmp_ok $$row[1], 'eq', $blob1, ShowBlob($blob1);
- Test($state or $sth->finish)
- or DbiError($sth->err, $sth->errstr);
+ok $sth->finish;
- Test($state or undef $sth || 1)
- or DbiError($sth->err, $sth->errstr);
+$sth= $dbh->prepare("UPDATE $table SET name = ? WHERE id = 1") or die "$DBI::errstr";
- Test($state or $sth=
- $dbh->prepare("SELECT * FROM $table WHERE id = 1"))
- or DbiError($dbh->err, $dbh->errstr);
+ok $sth->execute($blob2), 'inserting $blob2';
- Test($state or $sth->execute)
- or DbiError($dbh->err, $dbh->errstr);
+ok ($sth->finish);
- Test($state or (defined($row = $sth->fetchrow_arrayref)))
- or DbiError($sth->err, $sth->errstr);
+$sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1") or die "$DBI::errstr";
- Test($state or (@$row == 2 && $$row[0] == 1 && $$row[1] eq $blob2))
- or (ShowBlob($blob2),
- ShowBlob(defined($$row[1]) ? $$row[1] : ""));
+ok ($sth->execute);
- Test($state or $sth->finish)
- or DbiError($sth->err, $sth->errstr);
+$row = $sth->fetchrow_arrayref or die "$DBI::errstr";
- Test($state or undef $sth || 1)
- or DbiError($sth->err, $sth->errstr);
+cmp_ok scalar @$row, '==', 2, 'two rows';
-#
-# Finally drop the test table.
-#
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
-}
+cmp_ok $$row[0], '==', 1, 'row id == 1';
+
+cmp_ok $$row[1], 'eq', $blob2, ShowBlob($blob2);
+
+ok ($sth->finish);
+
+ok $dbh->do("DROP TABLE $table"), "drop $table";
+
+ok $dbh->disconnect;
Modified: DBD-mysql/trunk/t/50chopblanks.t
==============================================================================
--- DBD-mysql/trunk/t/50chopblanks.t (original)
+++ DBD-mysql/trunk/t/50chopblanks.t Wed May 7 04:22:16 2008
@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
@@ -9,136 +9,63 @@
#
# Make -w happy
#
-use vars qw($test_dsn $test_user $test_password $mdriver $verbose $state
- $dbdriver);
-use vars qw($COL_NULLABLE $COL_KEY);
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-use DBI;
use strict;
-$mdriver = "";
-{
- my $file;
- foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
- }
+use DBI;
+use Test::More;
+use lib 't', '.';
+require 'lib.pl';
+
+use vars qw($test_dsn $test_user $test_password $table);
+
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
}
+plan tests => 21;
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- my ($dbh, $sth, $query);
+ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ServerError();
-
- my $table = 't1';
- Test($state or $dbh->do("DROP TABLE IF EXISTS $table"))
- or ErrMsgF("Drop table $table failed", $dbh->errstr);
+my $create= <<EOT;
+CREATE TABLE $table (
+ id INT(4),
+ name VARCHAR(64)
+)
+EOT
+ok $dbh->do($create), "create table $table";
+my $sth= $dbh->prepare("INSERT INTO $table (id, name) VALUES (?, ?)") or die
"$DBI::errstr";
+my $sth2= $dbh->prepare("SELECT id, name FROM $table WHERE id = ?") or die
"$DBI::errstr";
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($query = TableDefinition($table,
- ["id", "INTEGER", 4, $COL_NULLABLE],
- ["name", "CHAR", 64, $COL_NULLABLE]),
- $dbh->do($query)))
- or ErrMsgF("Cannot create table: Error %s.\n",
- $dbh->errstr);
-
-
- #
- # and here's the right place for inserting new tests:
- #
- my @rows = ([1, ''],
- [2, ' '],
- [3, ' a b c ']);
- my $ref;
- foreach $ref (@rows) {
+my $rows = [ [1, ''], [2, ' '], [3, ' a b c ']];
+my $ref;
+for $ref (@$rows) {
my ($id, $name) = @$ref;
- if (!$state) {
- $query = sprintf("INSERT INTO $table (id, name) VALUES ($id, %s)",
- $dbh->quote($name));
- }
- Test($state or $dbh->do($query))
- or ErrMsgF("INSERT failed: query $query, error %s.\n",
- $dbh->errstr);
- $query = "SELECT id, name FROM $table WHERE id = $id\n";
- Test($state or ($sth = $dbh->prepare($query)))
- or ErrMsgF("prepare failed: query $query, error %s.\n",
- $dbh->errstr);
+ ok $sth->execute($id, $name), "inserting ($id, $name) into $table";
+ ok $sth2->execute($id), "selecting where id = $id";
# First try to retreive without chopping blanks.
- $sth->{'ChopBlanks'} = 0;
- Test($state or $sth->execute)
- or ErrMsgF("execute failed: query %s, error %s.\n", $query,
- $sth->errstr);
- Test($state or defined($ref = $sth->fetchrow_arrayref))
- or ErrMsgF("fetch failed: query $query, error %s.\n",
- $sth->errstr);
- Test($state or ($$ref[1] eq $name)
- or ($name =~ /^$$ref[1]\s+$/ &&
- ($dbdriver eq 'mysql' || $dbdriver eq 'ODBC')))
- or ErrMsgF("problems with ChopBlanks = 0:"
- . " expected '%s', got '%s'.\n",
- $name, $$ref[1]);
- Test($state or $sth->finish());
+ $sth2->{'ChopBlanks'} = 0;
+ $ref = $sth2->fetchrow_arrayref or die "$DBI::errstr";
+ cmp_ok $$ref[1], 'eq', $name, "\$name should not have blanks chopped";
# Now try to retreive with chopping blanks.
- $sth->{'ChopBlanks'} = 1;
- Test($state or $sth->execute)
- or ErrMsg("execute failed: query $query, error %s.\n",
- $sth->errstr);
+ $sth2->{'ChopBlanks'} = 1;
+
+ ok $sth2->execute($id);
+
my $n = $name;
$n =~ s/\s+$//;
- Test($state or ($ref = $sth->fetchrow_arrayref))
- or ErrMsgF("fetch failed: query $query, error %s.\n",
- $sth->errstr);
- Test($state or ($$ref[1] eq $n))
- or ErrMsgF("problems with ChopBlanks = 1:"
- . " expected '%s', got '%s'.\n",
- $n, $$ref[1]);
-
- Test($state or $sth->finish)
- or ErrMsgF("Cannot finish: %s.\n", $sth->errstr);
- }
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
-
- # ... and disconnect
- Test($state or $dbh->disconnect)
- or ErrMsgF("Cannot disconnect: %s.\n", $dbh->errmsg);
+ $ref = $sth2->fetchrow_arrayref or die "$DBI::errstr";
+
+ cmp_ok $$ref[1], 'eq', $n, "should have blanks chopped";
+
}
+ok $sth->finish;
+ok $sth2->finish;
+ok $dbh->do("DROP TABLE $table"), "drop $table";
+ok $dbh->disconnect;
Modified: DBD-mysql/trunk/t/50commit.t
==============================================================================
--- DBD-mysql/trunk/t/50commit.t (original)
+++ DBD-mysql/trunk/t/50commit.t Wed May 7 04:22:16 2008
@@ -1,223 +1,169 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
# This is testing the transaction support.
#
-$^W = 1;
-#
-# Include lib.pl
-#
-use DBI ();
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
+use DBI;
+use Test::More;
+use lib 't', '.';
+require 'lib.pl';
+
+use vars qw($got_warning $test_dsn $test_user $test_password $table);
+
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $DBI::errstr. Can't continue test";
}
-if ($mdriver eq 'whatever') {
- print "1..0\n";
- exit 0;
-}
-
-use vars qw($gotWarning);
-sub CatchWarning ($) {
- $gotWarning = 1;
+sub catch_warning ($) {
+ $got_warning = 1;
}
-
-sub NumRows($$$) {
+sub num_rows($$$) {
my($dbh, $table, $num) = @_;
my($sth, $got);
if (!($sth = $dbh->prepare("SELECT * FROM $table"))) {
- return "Failed to prepare: err " . $dbh->err . ", errstr "
- . $dbh->errstr;
+ return "Failed to prepare: err " . $dbh->err . ", errstr "
+ . $dbh->errstr;
}
if (!$sth->execute) {
- return "Failed to execute: err " . $dbh->err . ", errstr "
- . $dbh->errstr;
+ return "Failed to execute: err " . $dbh->err . ", errstr "
+ . $dbh->errstr;
}
$got = 0;
while ($sth->fetchrow_arrayref) {
- ++$got;
+ ++$got;
}
if ($got ne $num) {
- return "Wrong result: Expected $num rows, got $got.\n";
+ return "Wrong result: Expected $num rows, got $got.\n";
}
return '';
}
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)),
- undef,
- "Attempting to connect.\n")
- or ErrMsgF("Cannot connect: Error %s.\n\n"
- . "Make sure, your database server is up and running.\n"
- . "Check that '$test_dsn' references a valid database"
- . " name.\nDBI error message: %s\n",
- $DBI::err, $DBI::errstr);
-
- my $have_transactions = HaveTransactions($dbh);
-
- $table= 't1';
- Test($state or $dbh->do("DROP TABLE IF EXISTS $table"))
- or ErrMsgF("Failed to drop table $table.\n",
- $dbh->err, $dbh->errstr);
-
- #
- # Create a new table
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or ErrMsgF("Cannot create table: Error %s.\n",
- $dbh->errstr);
-
- Test($state or $dbh->{AutoCommit})
- or ErrMsg("AutoCommit is off\n");
-
- #
- # Tests for databases that do support transactions
- #
- if ($have_transactions) {
- # Turn AutoCommit off
- $dbh->{AutoCommit} = 0;
- Test($state or (!$dbh->err && !$dbh->errstr &&
!$dbh->{AutoCommit}))
- or ErrMsgF("Failed to turn AutoCommit off: err %s, errstr %s\n",
- $dbh->err, $dbh->errstr);
-
- # Check rollback
- Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
- or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- my $msg;
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
- Test($state or $dbh->rollback)
- or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
-
- # Check commit
- Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
- or ErrMsgF("Failed to delete value: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
- Test($state or $dbh->commit)
- or ErrMsgF("Failed to commit: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
-
- # Check auto rollback after disconnect
- Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
- or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
- Test($state or $dbh->disconnect)
- or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
- $DBI::err, $DBI::errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
-
- # Check whether AutoCommit is on again
- Test($state or $dbh->{AutoCommit})
- or ErrMsg("AutoCommit is off\n");
-
- #
- # Tests for databases that don't support transactions
- #
- } else {
- if (!$state) {
- $@ = '';
- eval { $dbh->{AutoCommit} = 0; }
- }
- $dbdriver = "" unless $dbdriver; # Avoid "used only once" warning
- Test($state or $@ or $dbdriver eq "mysql" or $dbdriver eq "mysqlEmb")
- or ErrMsg("Expected fatal error for AutoCommit => 0\n");
-
- for (my $i = 0; $i < 14; $i++) {
- Skip("Unable to detect a transactional table type; Skipping transaction tests");
- }
- }
+$have_transactions = have_transactions($dbh);
+my $engine= $have_transactions ? 'InnoDB' : 'MyISAM';
- # Check whether AutoCommit mode works.
- Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
- or ErrMsgF("Failed to delete: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
- Test($state or $dbh->disconnect)
- or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
- $DBI::err, $DBI::errstr);
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
-
- # Check whether commit issues a warning in AutoCommit mode
- Test($state or $dbh->do("INSERT INTO $table VALUES (2, 'Tim')"))
- or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- my $result;
- if (!$state) {
- $@ = '';
- $SIG{__WARN__} = \&CatchWarning;
- $gotWarning = 0;
- eval { $result = $dbh->commit; };
- $SIG{__WARN__} = 'DEFAULT';
- }
- Test($state or $gotWarning)
- or ErrMsg("Missing warning when committing in AutoCommit mode");
+if ($have_transactions) {
+ plan tests => 20;
- # Check whether rollback issues a warning in AutoCommit mode
- # We accept error messages as being legal, because the DBI
- # requirement of just issueing a warning seems scary.
- Test($state or $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"))
- or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- if (!$state) {
- $@ = '';
- $SIG{__WARN__} = \&CatchWarning;
- $gotWarning = 0;
- eval { $result = $dbh->rollback; };
- $SIG{__WARN__} = 'DEFAULT';
- }
- Test($state or $gotWarning or $dbh->err)
- or ErrMsg("Missing warning when rolling back in AutoCommit mode");
+ ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
+ my $create =<<EOT;
+ CREATE TABLE $table (
+ id INT(4) NOT NULL default 0,
+ name VARCHAR(64) NOT NULL default ''
+ ) ENGINE=$engine
+EOT
+
+ ok $dbh->do($create), 'create $table';
+
+ ok !$dbh->{AutoCommit}, "\$dbh->{AutoCommit} not defined
|$dbh->{AutoCommit}|";
+
+ $dbh->{AutoCommit} = 0;
+ ok !$dbh->err;
+ ok !$dbh->errstr;
+ ok !$dbh->{AutoCommit};
+
+ ok $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"),
+ "insert into $table (1, 'Jochen')";
+
+ my $msg;
+ $msg = num_rows($dbh, $table, 1);
+ ok !$msg;
+
+ ok $dbh->rollback, 'rollback';
+
+ $msg = num_rows($dbh, $table, 0);
+ ok !$msg;
+
+ ok $dbh->do("DELETE FROM $table WHERE id = 1"), "delete from $table where id = 1";
+
+ $msg = num_rows($dbh, $table, 0);
+ ok !$msg;
+ ok $dbh->commit, 'commit';
+
+ $msg = num_rows($dbh, $table, 0);
+ ok !$msg;
+
+ # Check auto rollback after disconnect
+ ok $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')");
+
+ $msg = num_rows($dbh, $table, 1);
+ ok !$msg;
+
+ ok $dbh->disconnect;
+
+ $dbh = DBI->connect($test_dsn, $test_user, $test_password) or die "$DBI::errstr";
+
+ ok $dbh, "connected";
+
+ $msg = num_rows($dbh, $table, 0);
+ ok !$msg;
+
+ ok $dbh->{AutoCommit}, "\$dbh->{AutoCommit} $dbh->{AutoCommit}";
+
+}
+else {
+ plan tests => 11;
+
+ ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
+ my $create =<<EOT;
+ CREATE TABLE $table (
+ id INT(4) NOT NULL default 0,
+ name VARCHAR(64) NOT NULL default ''
+ ) ENGINE=$engine
+EOT
+
+ ok $dbh->do($create), 'create $table';
+
+ # Tests for databases that don't support transactions
+ # Check whether AutoCommit mode works.
+
+ ok $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')");
+ $msg = num_rows($dbh, $table, 1);
+ ok !$msg;
+
+ ok $dbh->disconnect;
+ $dbh = DBI->connect($test_dsn, $test_user, $test_password) or die "$DBI::errstr";
+ ok ($dbh);
+
+ $msg = num_rows($dbh, $table, 1);
+ ok !$msg;
+
+ ok $dbh->do("INSERT INTO $table VALUES (2, 'Tim')");
+
+ my $result;
+ $@ = '';
+
+ $SIG{__WARN__} = \&catch_warning;
+
+ $got_warning = 0;
+
+ eval { $result = $dbh->commit; };
+
+ $SIG{__WARN__} = 'DEFAULT';
+
+ ok $got_warning;
+
+# Check whether rollback issues a warning in AutoCommit mode
+# We accept error messages as being legal, because the DBI
+# requirement of just issuing a warning seems scary.
+ ok $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')");
+
+ $@ = '';
+ $SIG{__WARN__} = \&catch_warning;
+ $got_warning = 0;
+ eval { $result = $dbh->rollback; };
+ $SIG{__WARN__} = 'DEFAULT';
+ ok $got_warning, "Should be warning defined upon rollback of non-trx table";
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
- Test($state or $dbh->disconnect())
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
+ ok $dbh->do("DROP TABLE $table");
+ ok $dbh->disconnect();
}
Modified: DBD-mysql/trunk/t/60leaks.t
==============================================================================
--- DBD-mysql/trunk/t/60leaks.t (original)
+++ DBD-mysql/trunk/t/60leaks.t Wed May 7 04:22:16 2008
@@ -1,237 +1,214 @@
-#!/usr/local/bin/perl
+#!perl -w
#
# $Id$
#
# This is a skeleton test. For writing new tests, take this file
# and modify/extend it.
#
+use strict;
+use DBI;
+use Test::More;
+use Carp qw(croak);
+use Data::Dumper;
+use vars qw($table $test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
my $COUNT_CONNECT = 4000; # Number of connect/disconnect iterations
my $COUNT_PREPARE = 10000; # Number of prepare/execute/finish iterations
-
-my $haveStorable;
+my $have_storable;
if (!$ENV{SLOW_TESTS}) {
- print "1..0 # Skip \$ENV{SLOW_TESTS} is not set\n";
- exit 0;
+ plan skip_all => "Skip \$ENV{SLOW_TESTS} is not set\n";
}
+
eval { require Proc::ProcessTable; };
if ($@) {
- print "1..0 # Skip Proc::ProcessTable not installed \n";
- exit 0;
-}
-eval { require Storable };
-$haveStorable = $@ ? 0 : 1;
-
-sub size {
- my($p, $pt);
- $pt = Proc::ProcessTable->new('cache_ttys' => $haveStorable);
- foreach $p (@{$pt->table()}) {
- if ($p->pid() == $$) {
- return $p->size();
- }
- }
- die "Cannot find my own process?!?\n";
- exit 0;
+ plan skip_all => "Skip Proc::ProcessTable not installed \n";
}
-#
-# Make -w happy
-#
-$test_dsn = $test_user = $test_password = '';
-
+eval { require Storable };
+$have_storable = $@ ? 0 : 1;
-#
-# Include lib.pl
-#
-require DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($mdriver eq 'whatever') {
- print "1..0\n";
- exit 0;
+my ($dbh, $sth);
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+if ($@) {
+ plan skip_all =>
+ "ERROR: $@. Can't continue test";
}
+plan tests => 21;
+sub size {
+ my($p, $pt);
+ $pt = Proc::ProcessTable->new('cache_ttys' => $have_storable);
+ for $p (@{$pt->table()}) {
+ if ($p->pid() == $$) {
+ return $p->size();
+ }
+ }
+ die "Cannot find my own process?!?\n";
+ exit 0;
+}
+
+ok $dbh->do("DROP TABLE IF EXISTS $table");
+
+my $create= <<EOT;
+CREATE TABLE $table (
+ id INT(4) NOT NULL DEFAULT 0,
+ name VARCHAR(64) NOT NULL DEFAULT ''
+ )
+EOT
+
+ok $dbh->do($create);
+
+my ($size, $prev_size, $ok, $not_ok, $dbh2, $msg);
+print "Testing memory leaks in connect/disconnect\n";
+$msg = "Possible memory leak in connect/disconnect detected";
+
+$ok = 0;
+$not_ok = 0;
+$prev_size= undef;
+
+for (my $i = 0; $i < $COUNT_CONNECT; $i++) {
+ eval {$dbh2 = DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+ if ($@) {
+ $not_ok++;
+ last;
+ }
+
+ if ($i % 100 == 99) {
+ $size = size();
+ if (defined($prev_size)) {
+ if ($size == $prev_size) {
+ $ok++;
+ }
+ else {
+ $not_ok++;
+ }
+ }
+ $prev_size = $size;
+ }
+}
+$dbh2->disconnect;
+
+ok $ok, "\$ok $ok $msg";
+ok !$not_ok, "\$not_ok $not_ok $msg";
+cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok $msg";
+
+print "Testing memory leaks in prepare/execute/finish\n";
+$msg = "Possible memory leak in prepare/execute/finish detected";
+
+$ok = 0;
+$not_ok = 0;
+undef $prev_size;
+
+for (my $i = 0; $i < $COUNT_PREPARE; $i++) {
+ my $sth = $dbh->prepare("SELECT * FROM $table") or die "$DBI::errstr";
+ $sth->execute();
+ $sth->finish();
+
+ if ($i % 100 == 99) {
+ $size = size();
+ if (defined($prev_size))
+ {
+ if ($size == $prev_size) {
+ $ok++;
+ }
+ else {
+ $not_ok++;
+ }
+ }
+ $prev_size = $size;
+ }
+}
+
+ok $ok, $msg;
+ok !$not_ok, "\$ok $ok \$not_ok $not_ok $msg";
+cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok $msg";
+
+print "Testing memory leaks in fetchrow_arrayref\n";
+$msg = "Possible memory leak in fetchrow_arrayref detected";
+
+$sth= $dbh->prepare("INSERT INTO $table VALUES (?, ?)") or die "$DBI::errstr";
+
+my $dataref= [[1, 'Jochen Wiedmann'],
+ [2, 'Andreas K+ [3, 'Tim Bunce'],
+ [4, 'Alligator Descartes'],
+ [5, 'Jonathan Leffler']];
+
+for (@$dataref) {
+ ok $sth->execute($_->[0], $_->[1]),
+ "insert into $table values ($_->[0], '$_->[1]')";
+}
+
+$ok = 0;
+$not_ok = 0;
+undef $prev_size;
+
+for (my $i = 0; $i < $COUNT_PREPARE; $i++) {
+ {
+ my $sth = $dbh->prepare("SELECT * FROM $table") or die "$DBI::errstr";
+ $sth->execute() or die "$DBI::errstr";
+ my $row;
+ while ($row = $sth->fetchrow_arrayref()) { }
+ $sth->finish();
+ }
+
+ if ($i % 100 == 99) {
+ $size = size();
+ if (defined($prev_size)) {
+ if ($size == $prev_size) {
+ ++$ok;
+ }
+ else {
+ ++$not_ok;
+ }
+ }
+ $prev_size = $size;
+ }
+}
+
+ok $ok, $msg;
+ok !$not_ok, "\$ok $ok \$not_ok $not_ok $msg";
+cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok $msg";
+
+print "Testing memory leaks in fetchrow_hashref\n";
+$msg = "Possible memory leak in fetchrow_hashref detected";
+
+$ok = 0;
+$not_ok = 0;
+undef $prev_size;
+
+for (my $i = 0; $i < $COUNT_PREPARE; $i++) {
+ {
+ my $sth = $dbh->prepare("SELECT * FROM $table") or die "$DBI::errstr";
+ $sth->execute() or die "$DBI::errstr";
+ my $row;
+ while ($row = $sth->fetchrow_hashref()) { }
+ $sth->finish();
+ }
+
+ if ($i % 100 == 99) {
+ $size = size();
+ if (defined($prev_size)) {
+ if ($size == $prev_size) {
+ ++$ok;
+ }
+ else {
+ ++$not_ok;
+ }
+ }
+ $prev_size = $size;
+ }
+}
+
+ok $ok, $msg;
+ok !$not_ok, "\$ok $ok \$not_ok $not_ok $msg";
+cmp_ok $ok, '>', $not_ok, "\$ok $ok \$not_ok $not_ok $msg";
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)),
- undef,
- "Attempting to connect.\n")
- or ErrMsgF("Cannot connect: Error %s.\n\n"
- . "Make sure, your database server is up and running.\n"
- . "Check that '$test_dsn' references a valid database"
- . " name.\nDBI error message: $DBI::errstr");
-
- $table= 't1';
-
- Test($state or $dbh->do("DROP TABLE IF EXISTS $table"))
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or ErrMsgF("Cannot create table: Error %s.\n",
- $dbh->errstr);
-
-
- my($size, $prevSize, $ok, $notOk, $dbh2, $msg);
- if (!$state) {
- print "Testing memory leaks in connect/disconnect\n";
- $msg = "Possible memory leak in connect/disconnect detected";
-
- $ok = 0;
- $notOk = 0;
- for (my $i = 0; $i < $COUNT_CONNECT; $i++) {
- if (!($dbh2 = DBI->connect($test_dsn, $test_user,
- $test_password))) {
- $ok = 0;
- $msg = "Cannot connect: $DBI::errstr\n";
- last;
- }
- $dbh2->disconnect();
- undef $dbh2;
- if ($i % 100 == 99) {
- $size = size();
- if (defined($prevSize) && $size == $prevSize) {
- ++$ok;
- } else {
- ++$notOk;
- }
- $prevSize = $size;
- }
- }
- }
- Test($state or ($ok > $notOk))
- or print "$msg\n";
-
-
- if (!$state) {
- print "Testing memory leaks in prepare/execute/finish\n";
- $msg = "Possible memory leak in prepare/execute/finish detected";
-
- $ok = 0;
- $notOk = 0;
- undef $prevSize;
- for (my $i = 0; $i < $COUNT_PREPARE; $i++) {
- my $sth = $dbh->prepare("SELECT * FROM $table");
- $sth->execute();
- $sth->finish();
- undef $sth;
-
- if ($i % 100 == 99) {
- $size = size();
- if (defined($prevSize) && $size == $prevSize) {
- ++$ok;
- } else {
- ++$notOk;
- }
- $prevSize = $size;
- }
- }
- }
- Test($state or ($ok > $notOk))
- or print "$msg\n";
-
-
- if (!$state) {
- print "Testing memory leaks in fetchrow_arrayref\n";
- $msg = "Possible memory leak in fetchrow_arrayref detected";
-
- # Insert some records into the test table
- my $row;
- foreach $row ([1, 'Jochen Wiedmann'],
- [2, 'Andreas K- [3, 'Tim Bunce'],
- [4, 'Alligator Descartes'],
- [5, 'Jonathan Leffler']) {
- $dbh->do(sprintf("INSERT INTO $table VALUES (%d, %s)",
- $row->[0], $dbh->quote($row->[1])));
- }
-
- $ok = 0;
- $notOk = 0;
- undef $prevSize;
- for (my $i = 0; $i < $COUNT_PREPARE; $i++) {
- {
- my $sth = $dbh->prepare("SELECT * FROM $table");
- $sth->execute();
- my $row;
- while ($row = $sth->fetchrow_arrayref()) {
- }
- $sth->finish();
- }
-
- if ($i % 100 == 99) {
- $size = size();
- if (defined($prevSize) && $size == $prevSize) {
- ++$ok;
- } else {
- ++$notOk;
- }
- $prevSize = $size;
- }
- }
- }
- Test($state or ($ok > $notOk))
- or print "$msg\n";
-
-
- if (!$state) {
- print "Testing memory leaks in fetchrow_hashref\n";
- $msg = "Possible memory leak in fetchrow_hashref detected";
-
- $ok = 0;
- $notOk = 0;
- undef $prevSize;
- for (my $i = 0; $i < $COUNT_PREPARE; $i++) {
- {
- my $sth = $dbh->prepare("SELECT * FROM $table");
- $sth->execute();
- my $row;
- while ($row = $sth->fetchrow_hashref()) {
- }
- $sth->finish();
- }
-
- if ($i % 100 == 99) {
- $size = size();
- if (defined($prevSize) && $size == $prevSize) {
- ++$ok;
- } else {
- ++$notOk;
- }
- $prevSize = $size;
- }
- }
- }
- Test($state or ($ok > $notOk))
- or print "$msg\n";
-
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
- Test($state or $dbh->disconnect);
-}
+ok $dbh->do("DROP TABLE $table");
+ok $dbh->disconnect;
Modified: DBD-mysql/trunk/t/lib.pl
==============================================================================
--- DBD-mysql/trunk/t/lib.pl (original)
+++ DBD-mysql/trunk/t/lib.pl Wed May 7 04:22:16 2008
@@ -6,10 +6,11 @@
# whereever possible. For example, you define certain constants
# here and the like.
#
-
-require 5.003;
+# All this code is subject to being GUTTED soon
+#
use strict;
-use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password);
+use vars qw($table $mdriver $dbdriver $childPid $test_dsn $test_user $test_password);
+$table= 't1';
$| = 1; # flush stdout asap to keep in sync with stderr
@@ -204,6 +205,7 @@
#
# Print a DBI error message
#
+# TODO - This is on the chopping block
sub DbiError ($$) {
my ($rc, $err) = @_;
$rc ||= 0;
@@ -266,6 +268,15 @@
return $row[0];
}
+# nice function I saw in DBD::Pg test code
+sub byte_string {
+ my $ret = join( "|" ,unpack( "C*" ,$_[0] ) );
+ return $ret;
+}
+
+sub SQL_VARCHAR { 12 };
+sub SQL_INTEGER { 4 };
+
sub ErrMsg (@) { print (@_); }
sub ErrMsgF (@) { printf (@_); }
Modified: DBD-mysql/trunk/t/mysql.dbtest
==============================================================================
--- DBD-mysql/trunk/t/mysql.dbtest (original)
+++ DBD-mysql/trunk/t/mysql.dbtest Wed May 7 04:22:16 2008
@@ -6,89 +6,6 @@
my $have_transactions;
-# This function generates a mapping of ANSI type names to
-# database specific type names; it is called by TableDefinition().
-#
-sub AnsiTypeToDb ($;$) {
- my ($type, $size) = @_;
- my ($ret);
-
- if ((lc $type) eq 'blob') {
- if ($size >= 1 << 16) {
- $ret = 'MEDIUMBLOB';
- } else {
- $ret = 'BLOB';
- }
- } elsif ((lc $type) eq 'int' || (lc $type) eq 'integer') {
- $ret = $type;
- } elsif ((lc $type) eq 'char') {
- $ret = "CHAR($size)";
- } else {
- warn "Unknown type $type\n";
- $ret = $type;
- }
- $ret;
-}
-
-
-#
-# This function generates a table definition based on an
-# input list. The input list consists of references, each
-# reference referring to a single column. The column
-# reference consists of column name, type, size and a bitmask of
-# certain flags, namely
-#
-# $COL_NULLABLE - true, if this column may contain NULL's
-# $COL_KEY - true, if this column is part of the table's
-# primary key
-#
-# Hopefully there's no big need for you to modify this function,
-# if your database conforms to ANSI specifications.
-#
-
-sub TableDefinition ($@) {
- my($tablename, @cols) = @_;
- my($def);
-
- #
- # Should be acceptable for most ANSI conformant databases;
- #
- # msql 1 uses a non-ANSI definition of the primary key: A
- # column definition has the attribute "PRIMARY KEY". On
- # the other hand, msql 2 uses the ANSI fashion ...
- #
- my($col, @keys, @colDefs, $keyDef);
-
- #
- # Count number of keys
- #
- @keys = ();
- foreach $col (@cols) {
- if ($$col[2] & $::COL_KEY) {
- push(@keys, $$col[0]);
- }
- }
-
- foreach $col (@cols) {
- my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
- if (!($$col[3] & $::COL_NULLABLE)) {
- $colDef .= " NOT NULL";
- }
- push(@colDefs, $colDef);
- }
- if (@keys) {
- $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
- } else {
- $keyDef = "";
- }
- my $suffix = "";
- if ($have_transactions) {
- $suffix = " ENGINE=$have_transactions";
- }
- $def = sprintf("CREATE TABLE %s (%s%s)%s", $tablename,
- join(", ", @colDefs), $keyDef, $suffix);
-}
-
#
# This function generates a list of tables associated to a
@@ -115,44 +32,33 @@
"$dsn:$hostname";
}
-
-#
-# Return a string for checking, whether a given column is NULL.
-#
-sub IsNull($) {
- my($var) = @_;
-
- "$var IS NULL";
-}
-
-
#
# Return TRUE, if database supports transactions
#
-sub HaveTransactions () {
- my $dbh = shift;
+sub have_transactions () {
+ my ($dbh) = @_;
return 1 unless $dbh;
if (!defined($have_transactions)) {
- $have_transactions = "";
- my $sth = $dbh->prepare("SHOW VARIABLES");
- $sth->execute();
- while (my $row = $sth->fetchrow_hashref()) {
- if ($row->{'Variable_name'} eq 'have_bdb' &&
- $row->{'Value'} eq 'YES') {
- $have_transactions = "bdb";
- last;
- }
- if ($row->{'Variable_name'} eq 'have_innodb' &&
- $row->{'Value'} eq 'YES') {
- $have_transactions = "innodb";
- last;
- }
- if ($row->{'Variable_name'} eq 'have_gemini' &&
- $row->{'Value'} eq 'YES') {
- $have_transactions = "gemini";
- last;
- }
- }
+ $have_transactions = "";
+ my $sth = $dbh->prepare("SHOW VARIABLES");
+ $sth->execute();
+ while (my $row = $sth->fetchrow_hashref()) {
+ if ($row->{'Variable_name'} eq 'have_bdb' &&
+ $row->{'Value'} eq 'YES') {
+ $have_transactions = "bdb";
+ last;
+ }
+ if ($row->{'Variable_name'} eq 'have_innodb' &&
+ $row->{'Value'} eq 'YES') {
+ $have_transactions = "innodb";
+ last;
+ }
+ if ($row->{'Variable_name'} eq 'have_gemini' &&
+ $row->{'Value'} eq 'YES') {
+ $have_transactions = "gemini";
+ last;
+ }
+ }
}
return $have_transactions;
}
| Thread |
|---|
| • [svn:DBD-mysql] r11207 - DBD-mysql/trunk/t | capttofu | 7 May |
