1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00

resolved #71311; needs more tests for non-blobs

This commit is contained in:
Kenichi Ishigaki 2011-09-29 15:29:01 +00:00
parent 3da40e5361
commit 9a1b8fe4f0
3 changed files with 142 additions and 1 deletions

View file

@ -1,5 +1,9 @@
Changes for Perl extension DBD-SQLite
1.34_02 to be released
- Resolved #71311: binding output columns as SQL_BLOB returns
nothing (ISHIGAKI)
1.34_01 Thu 22 Sep 2011
- Updated to SQLite 3.7.8 (ISHIGAKI)
- Made util/getsqlite.pl work properly for SQLite 3.7.5+ (ISHIGAKI)

View file

@ -106,6 +106,26 @@ sqlite_type_to_odbc_type(int type)
}
}
static int
sqlite_type_from_odbc_type(int type)
{
switch(type) {
case SQL_INTEGER:
case SQL_SMALLINT:
case SQL_TINYINT:
case SQL_BIGINT:
return SQLITE_INTEGER;
case SQL_FLOAT:
case SQL_REAL:
case SQL_DOUBLE:
return SQLITE_FLOAT;
case SQL_BLOB:
return SQLITE_BLOB;
default:
return SQLITE_TEXT;
}
}
static void
sqlite_set_result(pTHX_ sqlite3_context *context, SV *result, int is_error)
{
@ -854,7 +874,7 @@ sqlite_st_fetch(SV *sth, imp_sth_t *imp_sth)
SV **sql_type = av_fetch(imp_sth->col_types, i, 0);
if (sql_type && SvOK(*sql_type)) {
if (SvIV(*sql_type)) {
col_type = SvIV(*sql_type);
col_type = sqlite_type_from_odbc_type(SvIV(*sql_type));
}
}
switch(col_type) {

View file

@ -0,0 +1,117 @@
#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok/;
use Test::More;
BEGIN {
if ( $] >= 5.008005 ) {
plan( tests => 50 );
} else {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::NoWarnings;
use DBI qw/:sql_types/;
my $dbh = connect_ok(sqlite_unicode => 1);
$dbh->do('create table test1 (a integer, b blob)');
my $blob = "\x{82}\x{A0}";
my $str = "\x{20ac}";
{
my $sth = $dbh->prepare('insert into test1 values (?, ?)');
$sth->execute(1, $blob);
$sth->bind_param(1, 2);;
$sth->bind_param(2, $blob, SQL_BLOB);
$sth->execute;
$sth->bind_param(1, 3);;
$sth->bind_param(2, $blob, {TYPE => SQL_BLOB});
$sth->execute;
$sth->execute(4, $str);
$sth->bind_param(1, 5);;
$sth->bind_param(2, utf8::encode($str), SQL_BLOB);
$sth->execute;
$sth->bind_param(1, 6);;
$sth->bind_param(2, utf8::encode($str), {TYPE => SQL_BLOB});
$sth->execute;
$sth->finish;
}
{
my $sth = $dbh->prepare('select * from test1');
$sth->execute;
my $expected = [undef, 1, 0, 0, 1, 1, 1];
for (1..6) {
my $row = $sth->fetch;
ok $row && $row->[0] == $_;
ok $row && utf8::is_utf8($row->[1]) == $expected->[$_],
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
}
$sth->finish;
}
{
my $sth = $dbh->prepare('select * from test1');
$sth->bind_col(1, \my $col1);
$sth->bind_col(2, \my $col2);
$sth->execute;
my $expected = [undef, 1, 0, 0, 1, 1, 1];
for (1..6) {
$sth->fetch;
ok $col1 && $col1 == $_;
ok $col1 && utf8::is_utf8($col2) == $expected->[$_],
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
}
$sth->finish;
}
{
my $sth = $dbh->prepare('select * from test1');
$sth->bind_col(1, \my $col1);
$sth->bind_col(2, \my $col2, SQL_BLOB);
$sth->execute;
my $expected = [undef, 0, 0, 0, 0, 0, 0];
for (1..6) {
$sth->fetch;
ok $col1 && $col1 == $_;
ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
}
$sth->finish;
}
{
my $sth = $dbh->prepare('select * from test1');
$sth->bind_col(1, \my $col1);
$sth->bind_col(2, \my $col2, {TYPE => SQL_BLOB});
$sth->execute;
my $expected = [undef, 0, 0, 0, 0, 0, 0];
for (1..6) {
$sth->fetch;
ok $col1 && $col1 == $_;
ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
}
$sth->finish;
}