Author: timbo
Date: Thu Feb 16 07:29:48 2006
New Revision: 2512
Modified:
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/t/10examp.t
Log:
Fixed error building on threaded enabled perl.
bind_columns now does what it can before returning an error
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Thu Feb 16 07:29:48 2006
@@ -1819,12 +1819,13 @@ sub _new_sth { # called by DBD::<drivern
my $attr;
$attr = shift if !defined $_[0] or ref($_[0]) eq 'HASH';
- return $sth->set_err(1, "bind_columns called with "[EMAIL PROTECTED]"
refs when $fields needed")
- if @_ != $fields;
-
my $idx = 0;
$sth->bind_col(++$idx, shift, $attr) or return
- while (@_);
+ while (@_ and $idx < $fields);
+
+ return $sth->set_err(1, "bind_columns called with ".([EMAIL
PROTECTED])." values but $fields are needed")
+ if @_ or $idx != $fields;
+
return 1;
}
@@ -5904,8 +5905,10 @@ The TYPE attribute for bind_col() was fi
$rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
Calls L</bind_col> for each column of the C<SELECT> statement.
-The C<bind_columns> method will die if the number of references does not
-match the number of fields.
+
+The list of references should have the same number of elements as the number of
+columns in the C<SELECT> statement. If it doesn't then C<bind_columns> will
+bind the elements given, upto the number of columns, and then return an error.
For maximum portability between drivers, bind_columns() should be called
after execute() and not before.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Thu Feb 16 07:29:48 2006
@@ -2041,6 +2041,7 @@ dbih_event(SV *hrv, const char *evtype,
STATIC I32
dbi_dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock)
{
+ dTHX;
I32 i;
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t (original)
+++ dbi/trunk/t/10examp.t Thu Feb 16 07:29:48 2006
@@ -4,13 +4,14 @@ use lib qw(blib/arch blib/lib); # needed
use DBI qw(:sql_types);
use Config;
use Cwd;
+use strict;
$^W = 1;
my $haveFileSpec = eval { require File::Spec };
require VMS::Filespec if $^O eq 'VMS';
-use Test::More tests => 254;
+use Test::More tests => 258;
# "globals"
my ($r, $dbh);
@@ -238,7 +239,7 @@ $dir =~ m/(.*)/; $dir = $1 || die;
# ---
-my($col0, $col1, $col2, $rows);
+my($col0, $col1, $col2, $col3, $rows);
my(@row_a, @row_b);
ok($csr_a->{Taint} = 1) unless $DBI::PurePerl && ok(1);
@@ -255,6 +256,11 @@ ok($row_a[1] eq $col1) or print "$row_a[
ok($row_a[2] eq $col2) or print "$row_a[2] ne $col2\n";
#$csr_a->trace(0);
+ok( ! $csr_a->bind_columns(undef, \($col0, $col1)) );
+like $csr_a->errstr, '/bind_columns called with 2 values but 3 are needed/',
'errstr should contain error message';
+ok( ! $csr_a->bind_columns(undef, \($col0, $col1, $col2, $col3)) );
+like $csr_a->errstr, '/bind_columns called with 4 values but 3 are needed/',
'errstr should contain error message';
+
SKIP: {
