Skip to content

Commit

Permalink
Add test for tied magic scalars
Browse files Browse the repository at this point in the history
  • Loading branch information
@pali
pali committed Dec 19, 2016
1 parent ce334a8 commit cc48dfc
Show file tree
Hide file tree
Showing 2 changed files with 135 additions and 0 deletions.
1 change: 1 addition & 0 deletions MANIFEST
View file
Original file line number Diff line number Diff line change
Expand Up @@ -73,6 +73,7 @@ t/90utf8_params.t
t/91errcheck.t
t/99_bug_server_prepare_blob_null.t
t/lib.pl
t/magic.t
t/manifest.t
t/mysql.dbtest
t/pod.t
Expand Down
134 changes: 134 additions & 0 deletions t/magic.t
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,134 @@
use strict;
use warnings;

use Test::More;
use DBI;

use vars qw($test_dsn $test_user $test_password);
require "t/lib.pl";

my $dbh = eval { DBI->connect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0, mysql_server_prepare_disable_fallback => 1 }) };
plan skip_all => "no database connection" if $@ or not $dbh;

plan tests => 288*2;

$dbh->do("CREATE TEMPORARY TABLE t(i INT)");

foreach my $mysql_enable_utf8 (0, 1) {
$dbh->{mysql_enable_utf8} = $mysql_enable_utf8;
foreach my $mysql_server_prepare (0, 1) {
$dbh->{mysql_server_prepare} = $mysql_server_prepare;
foreach my $val ('1', 1, 1.0, 1.1, undef, 'XX', "\N{U+100}") {
next if defined $val and (my $tmp1 = $val) eq "\N{U+100}" and not $mysql_enable_utf8;
{
my $param_str = $val;
tie my $param, 'TieScalarCounter', $param_str;
my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
tie my $statement, 'TieScalarCounter', $statement_str;
my $func = '$dbh->do(' . $statement_str . ', {}, ' . (defined $param_str ? $param_str : 'undef') . ')';
$dbh->do($statement, {}, $param);
is(tied($statement)->{fetch}, 1, "$func processes get magic on statement only once");
is(tied($statement)->{store}, 0, "$func does not process set magic on statement");
is(tied($param)->{fetch}, 1, "$func processes get magic on param only once");
is(tied($param)->{store}, 0, "$func does not process set magic on param");
}
{
my $param_str = $val;
tie my $param, 'TieScalarCounter', $param_str;
my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
tie my $statement, 'TieScalarCounter', $statement_str;
my $func = '$dbh->selectall_arrayref(' . $statement_str . ', {}, ' . (defined $param_str ? $param_str : 'undef') . ')';
$dbh->selectall_arrayref($statement, {}, $param);
is(tied($statement)->{fetch}, 1, "$func processes get magic on statement only once");
is(tied($statement)->{store}, 0, "$func does not process set magic on statement");
is(tied($param)->{fetch}, 1, "$func processes get magic on param only once");
is(tied($param)->{store}, 0, "$func does not process set magic on param");
}
{
my $param_str = $val;
tie my $param, 'TieScalarCounter', $param_str;
my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
tie my $statement, 'TieScalarCounter', $statement_str;
my $func1 = '$dbh->prepare(' . $statement_str . ')';
my $func2 = '$sth->execute(' . (defined $param_str ? $param_str : 'undef') . ')';
my $sth = $dbh->prepare($statement);
$sth->execute($param);
$sth->finish();
is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
}
{
my $param_str = $val;
tie my $param, 'TieScalarCounter', $param_str;
my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
tie my $statement, 'TieScalarCounter', $statement_str;
my $func1 = '$dbh->prepare(' . $statement_str . ')';
my $func2 = '$sth->bind_param(1, ' . (defined $param_str ? $param_str : 'undef') . ')';
my $sth = $dbh->prepare($statement);
$sth->bind_param(1, $param);
$sth->execute();
$sth->finish();
is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
}
next if defined $val and (my $tmp2 = $val) !~ /^[\d.]+$/;
{
my $param_str = $val;
tie my $param, 'TieScalarCounter', $param_str;
my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
tie my $statement, 'TieScalarCounter', $statement_str;
my $func1 = '$dbh->prepare(' . $statement_str . ')';
my $func2 = '$sth->bind_param(1, ' . (defined $param_str ? $param_str : 'undef') . ', SQL_INTEGER)';
my $sth = $dbh->prepare($statement);
$sth->bind_param(1, $param, DBI::SQL_INTEGER);
$sth->execute();
$sth->finish();
is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
}
{
my $param_str = $val;
tie my $param, 'TieScalarCounter', $param_str;
my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
tie my $statement, 'TieScalarCounter', $statement_str;
my $func1 = '$dbh->prepare(' . $statement_str . ')';
my $func2 = '$sth->bind_param(1, ' . (defined $param_str ? $param_str : 'undef') . ', SQL_INTEGER)';
my $sth = $dbh->prepare($statement);
$sth->bind_param(1, $param, DBI::SQL_FLOAT);
$sth->execute();
$sth->finish();
is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
}
}
}
}

$dbh->disconnect();

package TieScalarCounter;

sub TIESCALAR {
my ($class, $value) = @_;
return bless { fetch => 0, store => 0, value => $value }, $class;
}

sub FETCH {
my ($self) = @_;
$self->{fetch}++;
return $self->{value};
}

sub STORE {
my ($self, $value) = @_;
$self->{store}++;
$self->{value} = $value;
}

0 comments on commit cc48dfc

Please sign in to comment.