mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
DBD-SQLite: applied @CALL_FUNCS trick and removed several _func tests
This commit is contained in:
Kenichi Ishigaki
parent
3997c0ffaf
commit
19b512b0b8
12 changed files with 247 additions and 683 deletions
56
t/02_logon.t
56
t/02_logon.t
|
|
@ -8,40 +8,38 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
||||
}
|
||||
|
||||
use Test::NoWarnings;
|
||||
|
||||
plan tests => 10;
|
||||
plan tests => 9 * @CALL_FUNCS + 1;
|
||||
|
||||
# Ordinary connect
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' );
|
||||
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
|
||||
diag("sqlite_version=$dbh->{sqlite_version}");
|
||||
ok( $dbh->sqlite_busy_timeout, 'Found initial busy_timeout' );
|
||||
ok( $dbh->sqlite_busy_timeout(5000) );
|
||||
is( $dbh->sqlite_busy_timeout, 5000, 'Set busy_timeout to new value' );
|
||||
}
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
|
||||
# Attributes in the connect string
|
||||
SKIP: {
|
||||
unless ( $] >= 5.008005 ) {
|
||||
skip( 'Unicode is not supported before 5.8.5', 2 );
|
||||
# Ordinary connect
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' );
|
||||
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
|
||||
diag("sqlite_version=$dbh->{sqlite_version}");
|
||||
ok( $dbh->$call_func('busy_timeout'), 'Found initial busy_timeout' );
|
||||
ok( $dbh->$call_func(5000, 'busy_timeout') );
|
||||
is( $dbh->$call_func('busy_timeout'), 5000, 'Set busy_timeout to new value' );
|
||||
}
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=foo;unicode=1', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
is( $dbh->{unicode}, 1, 'Unicode is on' );
|
||||
}
|
||||
|
||||
# Connect to a memory database
|
||||
SCOPE: {
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=:memory:', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
# Attributes in the connect string
|
||||
SKIP: {
|
||||
unless ( $] >= 5.008005 ) {
|
||||
skip( 'Unicode is not supported before 5.8.5', 2 );
|
||||
}
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=foo;unicode=1', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
is( $dbh->{unicode}, 1, 'Unicode is on' );
|
||||
}
|
||||
|
||||
# Connect to a memory database
|
||||
SCOPE: {
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=:memory:', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,40 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# Tests basic login and pragma setting
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 10;
|
||||
use Test::NoWarnings;
|
||||
|
||||
# Ordinary connect
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' );
|
||||
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
|
||||
diag("sqlite_version=$dbh->{sqlite_version}");
|
||||
ok( $dbh->func('busy_timeout'), 'Found initial busy_timeout' );
|
||||
ok( $dbh->func(5000, 'busy_timeout') );
|
||||
is( $dbh->func('busy_timeout'), 5000, 'Set busy_timeout to new value' );
|
||||
}
|
||||
|
||||
# Attributes in the connect string
|
||||
SKIP: {
|
||||
unless ( $] >= 5.008005 ) {
|
||||
skip( 'Unicode is not supported before 5.8.5', 2 );
|
||||
}
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=foo;unicode=1', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
is( $dbh->{unicode}, 1, 'Unicode is on' );
|
||||
}
|
||||
|
||||
# Connect to a memory database
|
||||
SCOPE: {
|
||||
my $dbh = DBI->connect( 'dbi:SQLite:dbname=:memory:', '', '' );
|
||||
isa_ok( $dbh, 'DBI::db' );
|
||||
}
|
||||
|
|
@ -7,16 +7,11 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
||||
}
|
||||
|
||||
use Test::NoWarnings;
|
||||
|
||||
plan tests => 28;
|
||||
plan tests => 27 * @CALL_FUNCS + 1;
|
||||
|
||||
sub now {
|
||||
return time();
|
||||
|
|
@ -58,67 +53,71 @@ sub noop {
|
|||
return $_[0];
|
||||
}
|
||||
|
||||
my $dbh = connect_ok( PrintError => 0 );
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
my $dbh = connect_ok( PrintError => 0 );
|
||||
|
||||
ok($dbh->sqlite_create_function( "now", 0, \&now ));
|
||||
my $result = $dbh->selectrow_arrayref( "SELECT now()" );
|
||||
ok($dbh->$call_func( "now", 0, \&now, "create_function" ));
|
||||
my $result = $dbh->selectrow_arrayref( "SELECT now()" );
|
||||
|
||||
ok( $result->[0], 'Got a result' );
|
||||
ok( $result->[0], 'Got a result' );
|
||||
|
||||
$dbh->do( 'CREATE TEMP TABLE func_test ( a, b )' );
|
||||
$dbh->do( 'INSERT INTO func_test VALUES ( 1, 3 )' );
|
||||
$dbh->do( 'INSERT INTO func_test VALUES ( 0, 4 )' );
|
||||
$dbh->do( 'CREATE TEMP TABLE func_test ( a, b )' );
|
||||
$dbh->do( 'INSERT INTO func_test VALUES ( 1, 3 )' );
|
||||
$dbh->do( 'INSERT INTO func_test VALUES ( 0, 4 )' );
|
||||
|
||||
ok($dbh->sqlite_create_function( "add2", 2, \&add2 ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT add2(1,3)" );
|
||||
is($result->[0], 4, "SELECT add2(1,3)" );
|
||||
ok($dbh->$call_func( "add2", 2, \&add2, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT add2(1,3)" );
|
||||
is($result->[0], 4, "SELECT add2(1,3)" );
|
||||
|
||||
$result = $dbh->selectall_arrayref( "SELECT add2(a,b) FROM func_test" );
|
||||
is_deeply( $result, [ [4], [4] ], "SELECT add2(a,b) FROM func_test" );
|
||||
$result = $dbh->selectall_arrayref( "SELECT add2(a,b) FROM func_test" );
|
||||
is_deeply( $result, [ [4], [4] ], "SELECT add2(a,b) FROM func_test" );
|
||||
|
||||
ok($dbh->sqlite_create_function( "my_sum", -1, \&my_sum ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_sum( '2', 3, 4, '5')" );
|
||||
is( $result->[0], 14, "SELECT my_sum( '2', 3, 4, '5')" );
|
||||
ok($dbh->$call_func( "my_sum", -1, \&my_sum, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_sum( '2', 3, 4, '5')" );
|
||||
is( $result->[0], 14, "SELECT my_sum( '2', 3, 4, '5')" );
|
||||
|
||||
ok($dbh->sqlite_create_function( "error", -1, \&error ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT error( 'I died' )" );
|
||||
ok( !$result );
|
||||
like( $DBI::errstr, qr/function is dying: I died/ );
|
||||
ok($dbh->$call_func( "error", -1, \&error, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT error( 'I died' )" );
|
||||
ok( !$result );
|
||||
like( $DBI::errstr, qr/function is dying: I died/ );
|
||||
|
||||
ok($dbh->sqlite_create_function( "void_return", -1, \&void_return ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT void_return( 'I died' )" );
|
||||
is_deeply( $result, [ undef ], "SELECT void_return( 'I died' )" );
|
||||
ok($dbh->$call_func( "void_return", -1, \&void_return, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT void_return( 'I died' )" );
|
||||
is_deeply( $result, [ undef ], "SELECT void_return( 'I died' )" );
|
||||
|
||||
ok($dbh->sqlite_create_function( "return_null", -1, \&return_null ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT return_null()" );
|
||||
is_deeply( $result, [ undef ], "SELECT return_null()" );
|
||||
ok($dbh->$call_func( "return_null", -1, \&return_null, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT return_null()" );
|
||||
is_deeply( $result, [ undef ], "SELECT return_null()" );
|
||||
|
||||
ok($dbh->sqlite_create_function( "return2", -1, \&return2 ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT return2()" );
|
||||
is_deeply( $result, [ 2 ], "SELECT return2()" );
|
||||
ok($dbh->$call_func( "return2", -1, \&return2, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT return2()" );
|
||||
is_deeply( $result, [ 2 ], "SELECT return2()" );
|
||||
|
||||
ok($dbh->sqlite_create_function( "my_defined", 1, \&my_defined ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined(1)" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined(1)" );
|
||||
ok($dbh->$call_func( "my_defined", 1, \&my_defined, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined(1)" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined(1)" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined('')" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined('')" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined('')" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined('')" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined('abc')" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined('abc')" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined('abc')" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined('abc')" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined(NULL)" );
|
||||
is_deeply( $result, [ '0' ], "SELECT my_defined(NULL)" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined(NULL)" );
|
||||
is_deeply( $result, [ '0' ], "SELECT my_defined(NULL)" );
|
||||
|
||||
ok($dbh->sqlite_create_function( "noop", 1, \&noop ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(NULL)" );
|
||||
is_deeply( $result, [ undef ], "SELECT noop(NULL)" );
|
||||
ok($dbh->$call_func( "noop", 1, \&noop, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(NULL)" );
|
||||
is_deeply( $result, [ undef ], "SELECT noop(NULL)" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(1)" );
|
||||
is_deeply( $result, [ 1 ], "SELECT noop(1)" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(1)" );
|
||||
is_deeply( $result, [ 1 ], "SELECT noop(1)" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop('')" );
|
||||
is_deeply( $result, [ '' ], "SELECT noop('')" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop('')" );
|
||||
is_deeply( $result, [ '' ], "SELECT noop('')" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(1.0625)" );
|
||||
is_deeply( $result, [ 1.0625 ], "SELECT noop(1.0625)" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(1.0625)" );
|
||||
is_deeply( $result, [ 1.0625 ], "SELECT noop(1.0625)" );
|
||||
|
||||
$dbh->disconnect;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,117 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use 5.00503;
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 28;
|
||||
use Test::NoWarnings;
|
||||
|
||||
sub now {
|
||||
return time();
|
||||
}
|
||||
|
||||
sub add2 {
|
||||
my ( $a, $b ) = @_;
|
||||
return $a + $b;
|
||||
}
|
||||
|
||||
sub my_sum {
|
||||
my $sum = 0;
|
||||
foreach my $x (@_) {
|
||||
$sum += $x;
|
||||
}
|
||||
return $sum;
|
||||
}
|
||||
|
||||
sub error {
|
||||
die "function is dying: ", @_, "\n";
|
||||
}
|
||||
|
||||
sub void_return {
|
||||
}
|
||||
|
||||
sub return2 {
|
||||
return ( 1, 2 );
|
||||
}
|
||||
|
||||
sub return_null {
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub my_defined {
|
||||
defined($_[0]) ? 1 : 0;
|
||||
}
|
||||
|
||||
sub noop {
|
||||
return $_[0];
|
||||
}
|
||||
|
||||
my $dbh = connect_ok( PrintError => 0 );
|
||||
|
||||
ok($dbh->func( "now", 0, \&now, "create_function" ));
|
||||
my $result = $dbh->selectrow_arrayref( "SELECT now()" );
|
||||
|
||||
ok( $result->[0], 'Got a result' );
|
||||
|
||||
$dbh->do( 'CREATE TEMP TABLE func_test ( a, b )' );
|
||||
$dbh->do( 'INSERT INTO func_test VALUES ( 1, 3 )' );
|
||||
$dbh->do( 'INSERT INTO func_test VALUES ( 0, 4 )' );
|
||||
|
||||
ok($dbh->func( "add2", 2, \&add2, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT add2(1,3)" );
|
||||
is($result->[0], 4, "SELECT add2(1,3)" );
|
||||
|
||||
$result = $dbh->selectall_arrayref( "SELECT add2(a,b) FROM func_test" );
|
||||
is_deeply( $result, [ [4], [4] ], "SELECT add2(a,b) FROM func_test" );
|
||||
|
||||
ok($dbh->func( "my_sum", -1, \&my_sum, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_sum( '2', 3, 4, '5')" );
|
||||
is( $result->[0], 14, "SELECT my_sum( '2', 3, 4, '5')" );
|
||||
|
||||
ok($dbh->func( "error", -1, \&error, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT error( 'I died' )" );
|
||||
ok( !$result );
|
||||
like( $DBI::errstr, qr/function is dying: I died/ );
|
||||
|
||||
ok($dbh->func( "void_return", -1, \&void_return, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT void_return( 'I died' )" );
|
||||
is_deeply( $result, [ undef ], "SELECT void_return( 'I died' )" );
|
||||
|
||||
ok($dbh->func( "return_null", -1, \&return_null, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT return_null()" );
|
||||
is_deeply( $result, [ undef ], "SELECT return_null()" );
|
||||
|
||||
ok($dbh->func( "return2", -1, \&return2, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT return2()" );
|
||||
is_deeply( $result, [ 2 ], "SELECT return2()" );
|
||||
|
||||
ok($dbh->func( "my_defined", 1, \&my_defined, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined(1)" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined(1)" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined('')" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined('')" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined('abc')" );
|
||||
is_deeply( $result, [ 1 ], "SELECT my_defined('abc')" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT my_defined(NULL)" );
|
||||
is_deeply( $result, [ '0' ], "SELECT my_defined(NULL)" );
|
||||
|
||||
ok($dbh->func( "noop", 1, \&noop, "create_function" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(NULL)" );
|
||||
is_deeply( $result, [ undef ], "SELECT noop(NULL)" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(1)" );
|
||||
is_deeply( $result, [ 1 ], "SELECT noop(1)" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop('')" );
|
||||
is_deeply( $result, [ '' ], "SELECT noop('')" );
|
||||
|
||||
$result = $dbh->selectrow_arrayref( "SELECT noop(1.0625)" );
|
||||
is_deeply( $result, [ 1.0625 ], "SELECT noop(1.0625)" );
|
||||
|
|
@ -6,16 +6,11 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
||||
}
|
||||
|
||||
use Test::NoWarnings;
|
||||
|
||||
plan tests => 22;
|
||||
plan tests => 21 * @CALL_FUNCS + 1;
|
||||
|
||||
# Create the aggregate test packages
|
||||
SCOPE: {
|
||||
|
|
@ -75,62 +70,66 @@ SCOPE: {
|
|||
}
|
||||
}
|
||||
|
||||
my $dbh = connect_ok( PrintError => 0 );
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
my $dbh = connect_ok( PrintError => 0 );
|
||||
|
||||
$dbh->do( "CREATE TABLE aggr_test ( field )" );
|
||||
foreach my $val ( qw/NULL 1 'test'/ ) {
|
||||
$dbh->do( "INSERT INTO aggr_test VALUES ( $val )" );
|
||||
$dbh->do( "CREATE TABLE aggr_test ( field )" );
|
||||
foreach my $val ( qw/NULL 1 'test'/ ) {
|
||||
$dbh->do( "INSERT INTO aggr_test VALUES ( $val )" );
|
||||
}
|
||||
|
||||
ok($dbh->$call_func( "newcount", 0, "count_aggr", "create_aggregate" ));
|
||||
my $result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 3 );
|
||||
|
||||
# Make sure that the init() function is called correctly
|
||||
$result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" );
|
||||
ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
|
||||
|
||||
|
||||
# Test aggregate on empty table
|
||||
$dbh->do( "DROP TABLE aggr_empty_test;" );
|
||||
$dbh->do( "CREATE TABLE aggr_empty_test ( field )" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
# Make sure that the init() function is called correctly
|
||||
$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
|
||||
ok($dbh->$call_func( "defined", 1, 'obj_aggregate', "create_aggregate" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 2 );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 2 );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
|
||||
my $last_warn;
|
||||
local $SIG{__WARN__} = sub { $last_warn = join "", @_ };
|
||||
foreach my $fail ( qw/ new step finalize/ ) {
|
||||
$last_warn = '';
|
||||
my $aggr = new fail_aggregate( $fail );
|
||||
ok($dbh->$call_func( "fail_$fail", -1, $aggr, 'create_aggregate' ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
|
||||
|
||||
# No need to check this one, since step() will never be called
|
||||
# on an empty table
|
||||
next if $fail eq 'step';
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_empty_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
|
||||
}
|
||||
|
||||
my $aggr = new fail_aggregate( 'undef' );
|
||||
$last_warn = '';
|
||||
ok($dbh->$call_func( "fail_undef", -1, $aggr, 'create_aggregate' ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_undef() FROM aggr_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /new\(\) should return a blessed reference/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /new\(\) should return a blessed reference/ );
|
||||
|
||||
$dbh->disconnect;
|
||||
}
|
||||
|
||||
ok($dbh->sqlite_create_aggregate( "newcount", 0, "count_aggr" ));
|
||||
my $result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 3 );
|
||||
|
||||
# Make sure that the init() function is called correctly
|
||||
$result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" );
|
||||
ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
|
||||
|
||||
|
||||
# Test aggregate on empty table
|
||||
$dbh->do( "DROP TABLE aggr_empty_test;" );
|
||||
$dbh->do( "CREATE TABLE aggr_empty_test ( field )" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
# Make sure that the init() function is called correctly
|
||||
$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
|
||||
ok($dbh->sqlite_create_aggregate( "defined", 1, 'obj_aggregate' ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 2 );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 2 );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
|
||||
my $last_warn;
|
||||
local $SIG{__WARN__} = sub { $last_warn = join "", @_ };
|
||||
foreach my $fail ( qw/ new step finalize/ ) {
|
||||
$last_warn = '';
|
||||
my $aggr = new fail_aggregate( $fail );
|
||||
ok($dbh->sqlite_create_aggregate( "fail_$fail", -1, $aggr ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
|
||||
|
||||
# No need to check this one, since step() will never be called
|
||||
# on an empty table
|
||||
next if $fail eq 'step';
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_empty_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
|
||||
}
|
||||
|
||||
my $aggr = new fail_aggregate( 'undef' );
|
||||
$last_warn = '';
|
||||
ok($dbh->sqlite_create_aggregate( "fail_undef", -1, $aggr ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_undef() FROM aggr_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /new\(\) should return a blessed reference/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /new\(\) should return a blessed reference/ );
|
||||
|
|
|
|||
|
|
@ -1,129 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 22;
|
||||
use Test::NoWarnings;
|
||||
|
||||
# Create the aggregate test packages
|
||||
SCOPE: {
|
||||
package count_aggr;
|
||||
|
||||
sub new {
|
||||
bless { count => 0 }, shift;
|
||||
}
|
||||
|
||||
sub step {
|
||||
$_[0]{count}++;
|
||||
return;
|
||||
}
|
||||
|
||||
sub finalize {
|
||||
my $c = $_[0]{count};
|
||||
$_[0]{count} = undef;
|
||||
|
||||
return $c;
|
||||
}
|
||||
|
||||
package obj_aggregate;
|
||||
|
||||
sub new {
|
||||
bless { count => 0 }, shift;
|
||||
}
|
||||
|
||||
sub step {
|
||||
$_[0]{count}++ if defined $_[1];
|
||||
}
|
||||
|
||||
sub finalize {
|
||||
my $c = $_[0]{count};
|
||||
$_[0]{count} = undef;
|
||||
return $c;
|
||||
}
|
||||
|
||||
package fail_aggregate;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
if ( ref $class ) {
|
||||
die "new() failed on request" if $class->{'fail'} eq 'new';
|
||||
return undef if $class->{'fail'} eq 'undef';
|
||||
return bless { %$class }, ref $class;
|
||||
} else {
|
||||
return bless { 'fail' => $_[0] }, $class;
|
||||
}
|
||||
}
|
||||
|
||||
sub step {
|
||||
die "step() failed on request" if $_[0]{fail} eq 'step';
|
||||
}
|
||||
|
||||
sub finalize {
|
||||
die "finalize() failed on request" if $_[0]{fail} eq 'finalize';
|
||||
}
|
||||
}
|
||||
|
||||
my $dbh = connect_ok( PrintError => 0 );
|
||||
|
||||
$dbh->do( "CREATE TABLE aggr_test ( field )" );
|
||||
foreach my $val ( qw/NULL 1 'test'/ ) {
|
||||
$dbh->do( "INSERT INTO aggr_test VALUES ( $val )" );
|
||||
}
|
||||
|
||||
ok($dbh->func( "newcount", 0, "count_aggr", "create_aggregate" ));
|
||||
my $result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 3 );
|
||||
|
||||
# Make sure that the init() function is called correctly
|
||||
$result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" );
|
||||
ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
|
||||
|
||||
|
||||
# Test aggregate on empty table
|
||||
$dbh->do( "DROP TABLE aggr_empty_test;" );
|
||||
$dbh->do( "CREATE TABLE aggr_empty_test ( field )" );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
# Make sure that the init() function is called correctly
|
||||
$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
|
||||
ok($dbh->func( "defined", 1, 'obj_aggregate', "create_aggregate" ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 2 );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
|
||||
ok( $result && $result->[0] == 2 );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
|
||||
ok( $result && !$result->[0] );
|
||||
|
||||
my $last_warn;
|
||||
local $SIG{__WARN__} = sub { $last_warn = join "", @_ };
|
||||
foreach my $fail ( qw/ new step finalize/ ) {
|
||||
$last_warn = '';
|
||||
my $aggr = new fail_aggregate( $fail );
|
||||
ok($dbh->func( "fail_$fail", -1, $aggr, 'create_aggregate' ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
|
||||
|
||||
# No need to check this one, since step() will never be called
|
||||
# on an empty table
|
||||
next if $fail eq 'step';
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_empty_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
|
||||
}
|
||||
|
||||
my $aggr = new fail_aggregate( 'undef' );
|
||||
$last_warn = '';
|
||||
ok($dbh->func( "fail_undef", -1, $aggr, 'create_aggregate' ));
|
||||
$result = $dbh->selectrow_arrayref( "SELECT fail_undef() FROM aggr_test" );
|
||||
# ok( !$result && $DBI::errstr =~ /new\(\) should return a blessed reference/ );
|
||||
ok( !defined $result->[0] && $last_warn =~ /new\(\) should return a blessed reference/ );
|
||||
|
|
@ -6,16 +6,11 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
||||
}
|
||||
|
||||
use Test::NoWarnings;
|
||||
|
||||
plan tests => 6;
|
||||
plan tests => 5 * @CALL_FUNCS + 1;
|
||||
|
||||
my $N_OPCODES = 50; # how many opcodes before calling the progress handler
|
||||
|
||||
|
|
@ -26,30 +21,36 @@ sub progress_handler {
|
|||
return 0;
|
||||
}
|
||||
|
||||
# connect and register the progress handler
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
ok($dbh->sqlite_progress_handler( $N_OPCODES, \&progress_handler ));
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
$n_callback = 0; # reinitialize
|
||||
|
||||
# populate a temporary table with random numbers
|
||||
$dbh->do( 'CREATE TEMP TABLE progress_test ( foo )' );
|
||||
$dbh->begin_work;
|
||||
for my $count (1 .. 1000) {
|
||||
my $rand = rand;
|
||||
$dbh->do( "INSERT INTO progress_test(foo) VALUES ( $rand )" );
|
||||
# connect and register the progress handler
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
ok($dbh->$call_func( $N_OPCODES, \&progress_handler, "progress_handler" ));
|
||||
|
||||
# populate a temporary table with random numbers
|
||||
$dbh->do( 'CREATE TEMP TABLE progress_test ( foo )' );
|
||||
$dbh->begin_work;
|
||||
for my $count (1 .. 1000) {
|
||||
my $rand = rand;
|
||||
$dbh->do( "INSERT INTO progress_test(foo) VALUES ( $rand )" );
|
||||
}
|
||||
$dbh->commit;
|
||||
|
||||
# let the DB do some work (sorting the random numbers)
|
||||
my $result = $dbh->do( "SELECT * from progress_test ORDER BY foo " );
|
||||
|
||||
# now the progress handler should have been called a number of times
|
||||
ok($n_callback);
|
||||
|
||||
|
||||
# unregister the progress handler, set counter back to zero, do more work
|
||||
ok($dbh->$call_func( $N_OPCODES, undef, "progress_handler" ));
|
||||
$n_callback = 0;
|
||||
$result = $dbh->do( "SELECT * from progress_test ORDER BY foo DESC " );
|
||||
|
||||
# now the progress handler should have been called zero times
|
||||
ok(!$n_callback);
|
||||
|
||||
$dbh->disconnect;
|
||||
}
|
||||
$dbh->commit;
|
||||
|
||||
# let the DB do some work (sorting the random numbers)
|
||||
my $result = $dbh->do( "SELECT * from progress_test ORDER BY foo " );
|
||||
|
||||
# now the progress handler should have been called a number of times
|
||||
ok($n_callback);
|
||||
|
||||
|
||||
# unregister the progress handler, set counter back to zero, do more work
|
||||
ok($dbh->sqlite_progress_handler( $N_OPCODES, undef ));
|
||||
$n_callback = 0;
|
||||
$result = $dbh->do( "SELECT * from progress_test ORDER BY foo DESC " );
|
||||
|
||||
# now the progress handler should have been called zero times
|
||||
ok(!$n_callback);
|
||||
|
|
|
|||
|
|
@ -1,48 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 6;
|
||||
use Test::NoWarnings;
|
||||
|
||||
my $N_OPCODES = 50; # how many opcodes before calling the progress handler
|
||||
|
||||
# our progress_handler just remembers how many times it was called
|
||||
my $n_callback = 0;
|
||||
sub progress_handler {
|
||||
$n_callback += 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
# connect and register the progress handler
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
ok($dbh->func( $N_OPCODES, \&progress_handler, "progress_handler" ));
|
||||
|
||||
# populate a temporary table with random numbers
|
||||
$dbh->do( 'CREATE TEMP TABLE progress_test ( foo )' );
|
||||
$dbh->begin_work;
|
||||
for my $count (1 .. 1000) {
|
||||
my $rand = rand;
|
||||
$dbh->do( "INSERT INTO progress_test(foo) VALUES ( $rand )" );
|
||||
}
|
||||
$dbh->commit;
|
||||
|
||||
# let the DB do some work (sorting the random numbers)
|
||||
my $result = $dbh->do( "SELECT * from progress_test ORDER BY foo " );
|
||||
|
||||
# now the progress handler should have been called a number of times
|
||||
ok($n_callback);
|
||||
|
||||
|
||||
# unregister the progress handler, set counter back to zero, do more work
|
||||
ok($dbh->func( $N_OPCODES, undef, "progress_handler" ));
|
||||
$n_callback = 0;
|
||||
$result = $dbh->do( "SELECT * from progress_test ORDER BY foo DESC " );
|
||||
|
||||
# now the progress handler should have been called zero times
|
||||
ok(!$n_callback);
|
||||
|
|
@ -4,61 +4,63 @@ use strict;
|
|||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
use t::lib::Test;
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use Test::NoWarnings;
|
||||
use DBI;
|
||||
|
||||
BEGIN {
|
||||
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
||||
}
|
||||
|
||||
plan tests => 6;
|
||||
|
||||
# Connect to the test db and add some stuff:
|
||||
my $foo = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
||||
$foo->do(
|
||||
'CREATE TABLE online_backup_test( id INTEGER PRIMARY KEY, foo INTEGER )'
|
||||
);
|
||||
$foo->do("INSERT INTO online_backup_test (foo) VALUES ($$)");
|
||||
|
||||
# That should be in the "foo" database on disk now, so disconnect and try to
|
||||
# back it up:
|
||||
|
||||
$foo->disconnect;
|
||||
|
||||
my $dbh = DBI->connect(
|
||||
'dbi:SQLite:dbname=:memory:',
|
||||
undef, undef,
|
||||
{ RaiseError => 1 }
|
||||
);
|
||||
|
||||
ok($dbh->sqlite_backup_from_file('foo'));
|
||||
|
||||
{
|
||||
my ($count) = $dbh->selectrow_array(
|
||||
"SELECT count(foo) FROM online_backup_test WHERE foo=$$"
|
||||
);
|
||||
is($count, 1, "Found our process ID in backed-up table");
|
||||
}
|
||||
|
||||
# Add more data then attempt to copy it back to file:
|
||||
$dbh->do(
|
||||
'CREATE TABLE online_backup_test2 ( id INTEGER PRIMARY KEY, foo INTEGER )'
|
||||
);
|
||||
$dbh->do("INSERT INTO online_backup_test2 (foo) VALUES ($$)");
|
||||
|
||||
# backup to file (foo):
|
||||
ok($dbh->sqlite_backup_to_file('foo'));
|
||||
|
||||
$dbh->disconnect;
|
||||
|
||||
# Reconnect to foo db and check data made it over:
|
||||
{
|
||||
my $foo = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
||||
|
||||
my ($count) = $foo->selectrow_array(
|
||||
"SELECT count(foo) FROM online_backup_test2 WHERE foo=$$"
|
||||
);
|
||||
is($count, 1, "Found our process ID in table back on disk");
|
||||
|
||||
$foo->disconnect;
|
||||
plan tests => 6 * @CALL_FUNCS + 1;
|
||||
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
# Connect to the test db and add some stuff:
|
||||
my $foo = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
||||
$foo->do(
|
||||
'CREATE TABLE online_backup_test( id INTEGER PRIMARY KEY, foo INTEGER )'
|
||||
);
|
||||
$foo->do("INSERT INTO online_backup_test (foo) VALUES ($$)");
|
||||
|
||||
# That should be in the "foo" database on disk now, so disconnect and try to
|
||||
# back it up:
|
||||
|
||||
$foo->disconnect;
|
||||
|
||||
my $dbh = DBI->connect(
|
||||
'dbi:SQLite:dbname=:memory:',
|
||||
undef, undef,
|
||||
{ RaiseError => 1 }
|
||||
);
|
||||
|
||||
ok($dbh->$call_func('foo', 'backup_from_file'));
|
||||
|
||||
{
|
||||
my ($count) = $dbh->selectrow_array(
|
||||
"SELECT count(foo) FROM online_backup_test WHERE foo=$$"
|
||||
);
|
||||
is($count, 1, "Found our process ID in backed-up table");
|
||||
}
|
||||
|
||||
# Add more data then attempt to copy it back to file:
|
||||
$dbh->do(
|
||||
'CREATE TABLE online_backup_test2 ( id INTEGER PRIMARY KEY, foo INTEGER )'
|
||||
);
|
||||
$dbh->do("INSERT INTO online_backup_test2 (foo) VALUES ($$)");
|
||||
|
||||
# backup to file (foo):
|
||||
ok($dbh->$call_func('foo', 'backup_to_file'));
|
||||
|
||||
$dbh->disconnect;
|
||||
|
||||
# Reconnect to foo db and check data made it over:
|
||||
{
|
||||
my $foo = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
||||
|
||||
my ($count) = $foo->selectrow_array(
|
||||
"SELECT count(foo) FROM online_backup_test2 WHERE foo=$$"
|
||||
);
|
||||
is($count, 1, "Found our process ID in table back on disk");
|
||||
|
||||
$foo->disconnect;
|
||||
}
|
||||
$dbh->disconnect;
|
||||
|
||||
unlink 'foo';
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,58 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 6;
|
||||
use t::lib::Test;
|
||||
use DBI;
|
||||
|
||||
# Connect to the test db and add some stuff:
|
||||
my $foo = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
||||
$foo->do(
|
||||
'CREATE TABLE online_backup_test( id INTEGER PRIMARY KEY, foo INTEGER )'
|
||||
);
|
||||
$foo->do("INSERT INTO online_backup_test (foo) VALUES ($$)");
|
||||
|
||||
# That should be in the "foo" database on disk now, so disconnect and try to
|
||||
# back it up:
|
||||
|
||||
$foo->disconnect;
|
||||
|
||||
my $dbh = DBI->connect(
|
||||
'dbi:SQLite:dbname=:memory:',
|
||||
undef, undef,
|
||||
{ RaiseError => 1 }
|
||||
);
|
||||
|
||||
ok($dbh->func('foo', 'backup_from_file'));
|
||||
|
||||
{
|
||||
my ($count) = $dbh->selectrow_array(
|
||||
"SELECT count(foo) FROM online_backup_test WHERE foo=$$"
|
||||
);
|
||||
is($count, 1, "Found our process ID in backed-up table");
|
||||
}
|
||||
|
||||
# Add more data then attempt to copy it back to file:
|
||||
$dbh->do(
|
||||
'CREATE TABLE online_backup_test2 ( id INTEGER PRIMARY KEY, foo INTEGER )'
|
||||
);
|
||||
$dbh->do("INSERT INTO online_backup_test2 (foo) VALUES ($$)");
|
||||
|
||||
# backup to file (foo):
|
||||
ok($dbh->func('foo', 'backup_to_file'));
|
||||
|
||||
$dbh->disconnect;
|
||||
|
||||
# Reconnect to foo db and check data made it over:
|
||||
{
|
||||
my $foo = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
||||
|
||||
my ($count) = $foo->selectrow_array(
|
||||
"SELECT count(foo) FROM online_backup_test2 WHERE foo=$$"
|
||||
);
|
||||
is($count, 1, "Found our process ID in table back on disk");
|
||||
|
||||
$foo->disconnect;
|
||||
}
|
||||
|
|
@ -6,13 +6,11 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
||||
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 16 );
|
||||
plan( tests => 15 * @CALL_FUNCS + 1);
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
|
|
@ -22,22 +20,25 @@ use Test::NoWarnings;
|
|||
eval "require utf8";
|
||||
die $@ if $@;
|
||||
|
||||
my $dbh = connect_ok( unicode => 1 );
|
||||
ok($dbh->sqlite_create_function( "perl_uc", 1, \&perl_uc ));
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
my $dbh = connect_ok( unicode => 1 );
|
||||
ok($dbh->$call_func( "perl_uc", 1, \&perl_uc, "create_function" ));
|
||||
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE foo (
|
||||
bar varchar(255)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
my @words = qw{Bergère hôte hétaïre hêtre};
|
||||
foreach my $word (@words) {
|
||||
utf8::upgrade($word);
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $word), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT perl_uc(bar) FROM foo");
|
||||
is_deeply( $foo, [ [ perl_uc($word) ] ], 'unicode upcase ok' );
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
my @words = qw{Bergère hôte hétaïre hêtre};
|
||||
foreach my $word (@words) {
|
||||
utf8::upgrade($word);
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $word), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT perl_uc(bar) FROM foo");
|
||||
is_deeply( $foo, [ [ perl_uc($word) ] ], 'unicode upcase ok' );
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
}
|
||||
$dbh->disconnect;
|
||||
}
|
||||
|
||||
sub perl_uc {
|
||||
|
|
|
|||
|
|
@ -1,44 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 16 );
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
}
|
||||
use Test::NoWarnings;
|
||||
|
||||
eval "require utf8";
|
||||
die $@ if $@;
|
||||
|
||||
my $dbh = connect_ok( unicode => 1 );
|
||||
ok($dbh->func( "perl_uc", 1, \&perl_uc, "create_function" ));
|
||||
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE foo (
|
||||
bar varchar(255)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
my @words = qw{Bergère hôte hétaïre hêtre};
|
||||
foreach my $word (@words) {
|
||||
utf8::upgrade($word);
|
||||
ok( $dbh->do("INSERT INTO foo VALUES ( ? )", {}, $word), 'INSERT' );
|
||||
my $foo = $dbh->selectall_arrayref("SELECT perl_uc(bar) FROM foo");
|
||||
is_deeply( $foo, [ [ perl_uc($word) ] ], 'unicode upcase ok' );
|
||||
ok( $dbh->do("DELETE FROM foo"), 'DELETE ok' );
|
||||
}
|
||||
|
||||
sub perl_uc {
|
||||
my $string = shift;
|
||||
return uc($string);
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue