mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
c4eab85ff7
Zero functional changes, simply executed the following:
find . -name '*.t' -exec perl -0777 -p -i -e 's|^use t::lib::SQLiteTest|use lib "t/lib";\nuse SQLiteTest|m' {} +
Also had to do a manual (but identical) fix in t/01_compile.t
83 lines
1.4 KiB
Perl
83 lines
1.4 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
BEGIN {
|
|
$| = 1;
|
|
$^W = 1;
|
|
}
|
|
|
|
use lib "t/lib";
|
|
use SQLiteTest;
|
|
use Test::More tests => 27;
|
|
use Test::NoWarnings;
|
|
|
|
my $dbh = connect_ok(
|
|
RaiseError => 1,
|
|
PrintError => 0,
|
|
AutoCommit => 0,
|
|
);
|
|
|
|
ok($dbh->do("CREATE TABLE Blah ( id INTEGER, val VARCHAR )"));
|
|
ok($dbh->commit);
|
|
|
|
my $blob = "";
|
|
|
|
my $b = "";
|
|
for my $j (0..255) {
|
|
$b .= chr($j);
|
|
}
|
|
for my $i (0..127) {
|
|
$blob .= $b;
|
|
}
|
|
|
|
ok($blob);
|
|
dumpblob($blob);
|
|
|
|
my $sth = $dbh->prepare("INSERT INTO Blah VALUES (?, ?)");
|
|
|
|
ok($sth);
|
|
|
|
for (1..5) {
|
|
ok($sth->execute($_, $blob));
|
|
}
|
|
|
|
$sth->finish;
|
|
|
|
undef $sth;
|
|
|
|
my $sel = $dbh->prepare("SELECT * FROM Blah WHERE id = ?");
|
|
|
|
ok($sel);
|
|
|
|
for (1..5) {
|
|
$sel->execute($_);
|
|
my $row = $sel->fetch;
|
|
ok($row->[0] == $_);
|
|
dumpblob($row->[1]);
|
|
ok($row->[1] eq $blob);
|
|
ok(!$sel->fetch);
|
|
}
|
|
|
|
$dbh->rollback;
|
|
|
|
sub dumpblob {
|
|
my $blob = shift;
|
|
print("# showblob length: ", length($blob), "\n");
|
|
|
|
if ($ENV{SHOW_BLOBS}) { open(OUT, ">>$ENV{SHOW_BLOBS}") }
|
|
my $i = 0;
|
|
while (1) {
|
|
if (defined($blob) && length($blob) > ($i*32)) {
|
|
$b = substr($blob, $i*32);
|
|
} else {
|
|
$b = "";
|
|
last;
|
|
}
|
|
if ($ENV{SHOW_BLOBS}) { printf OUT "%08lx %s\n", $i*32, unpack("H64", $b) }
|
|
else { printf("# %08lx %s\n", $i*32, unpack("H64", $b)) }
|
|
$i++;
|
|
last if $i == 8;
|
|
}
|
|
if ($ENV{SHOW_BLOBS}) { close(OUT) }
|
|
}
|
|
|