require 5.003;
use strict;
use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password
$haveFileSpec);
$mdriver = 'SQLite';
$dbdriver = $mdriver;
mkdir 'output';
$haveFileSpec = eval { require File::Spec };
my $table_dir = $haveFileSpec ?
File::Spec->catdir(File::Spec->curdir(), 'output', 'foo') : 'output/foo';
$test_dsn = $ENV{'DBI_DSN'}
|| "DBI:$dbdriver:dbname=$table_dir";
$test_user = $ENV{'DBI_USER'} || "";
$test_password = $ENV{'DBI_PASS'} || "";
$::COL_NULLABLE = 1;
$::COL_KEY = 2;
my $file;
if (-f ($file = "t/$dbdriver.dbtest") ||
-f ($file = "$dbdriver.dbtest") ||
-f ($file = "../tests/$dbdriver.dbtest") ||
-f ($file = "tests/$dbdriver.dbtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
}
if (-f ($file = "t/$mdriver.mtest") ||
-f ($file = "$mdriver.mtest") ||
-f ($file = "../tests/$mdriver.mtest") ||
-f ($file = "tests/$mdriver.mtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
}
open (STDERR, ">&STDOUT") || die "Cannot redirect stderr" ;
select (STDERR) ; $| = 1 ;
select (STDOUT) ; $| = 1 ;
{
my (@stateStack, $count, $off);
$count = 0;
sub Testing(;$) {
my ($command) = shift;
if (!defined($command)) {
@stateStack = ();
$off = 0;
if ($count == 0) {
++$count;
$::state = 1;
} elsif ($count == 1) {
my($d);
if ($off) {
print "1..0\n";
exit 0;
}
++$count;
$::state = 0;
print "1..$::numTests\n";
} else {
return 0;
}
if ($off) {
$::state = 1;
}
$::numTests = 0;
} elsif ($command eq 'off') {
$off = 1;
$::state = 0;
} elsif ($command eq 'group') {
push(@stateStack, $::state);
} elsif ($command eq 'disable') {
$::state = 0;
} elsif ($command eq 'enable') {
if ($off) {
$::state = 0;
} else {
my $s;
$::state = 1;
foreach $s (@stateStack) {
if (!$s) {
$::state = 0;
last;
}
}
}
return;
} elsif ($command eq 'finish') {
$::state = pop(@stateStack);
} else {
die("Testing: Unknown argument\n");
}
return 1;
}
sub Test ($;$$) {
my($result, $error, $diag) = @_;
++$::numTests;
if ($count == 2) {
if (defined($diag)) {
printf("$diag%s", (($diag =~ /\n$/) ? "" : "\n"));
}
if ($::state || $result) {
print "ok $::numTests ". (defined($error) ? "$error\n" : "\n");
return 1;
} else {
print("not ok $::numTests - " .
(defined($error) ? "$error\n" : "\n"));
print("FAILED Test $::numTests - " .
(defined($error) ? "$error\n" : "\n"));
return 0;
}
}
return 1;
}
}
sub DbiError ($$) {
my($rc, $err) = @_;
$rc ||= 0;
$err ||= '';
print "Test $::numTests: DBI error $rc, $err\n";
}
{
use vars qw($listTablesHook);
my(@tables, $testtable, $listed);
$testtable = "testaa";
$listed = 0;
sub FindNewTable($) {
my($dbh) = @_;
if (!$listed) {
if (defined($listTablesHook)) {
@tables = &$listTablesHook($dbh);
} elsif (defined(&ListTables)) {
@tables = &ListTables($dbh);
} else {
die "Fatal: ListTables not implemented.\n";
}
$listed = 1;
}
my $foundtesttable = 1;
my $table;
while ($foundtesttable) {
$foundtesttable = 0;
foreach $table (@tables) {
if ($table eq $testtable) {
$testtable++;
$foundtesttable = 1;
}
}
}
$table = $testtable;
$testtable++;
$table;
}
}
sub ErrMsg { print (@_); }
sub ErrMsgF { printf (@_); }
1;