#!/usr/bin/perl -w -I./t # $Id: rt_78838.t 15380 2012-09-07 13:20:19Z mjevans $ # # rt 78838 # # DBD::ODBC was stringifying input bound parameters. # This script creates an object with an overriden stringifcation method # and test it is stringified when bound. # use strict; use warnings; use Test::More; use DBI; use_ok('ODBCTEST'); eval "require Test::NoWarnings"; my $has_test_nowarnings = ($@ ? undef : 1); BEGIN { if (!defined $ENV{DBI_DSN}) { plan skip_all => "DBI_DSN is undefined"; } } END { Test::NoWarnings::had_no_warnings() if ($has_test_nowarnings); done_testing(); } my $dbh = DBI->connect(); unless($dbh) { BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n"); exit 0; } $dbh->{RaiseError} = 0; my $dbms_name = $dbh->get_info(17); ok($dbms_name, "got DBMS name: $dbms_name"); # 2 # this needs to be MS SQL Server if ($dbms_name !~ /Microsoft SQL Server/) { note('Not Microsoft SQL Server'); exit 0; } my $obj = new Object(); my $sth = $dbh->prepare(q/select ? AS result/); ok($sth, "statement prepared"); $sth->bind_param(1, $obj); SKIP: { skip "Failed to prepare statement", 4 if !$sth; $sth->execute(); my $fetched = $sth->fetchrow_arrayref->[0]; is($fetched, 'Object', "bound parameter correctly stringified"); # 1 bless $obj, 'Subject'; $sth->execute(); $fetched = $sth->fetchrow_arrayref->[0]; is($fetched, 'Object', "bound parameter copied and not a reference"); # 2 $sth->bind_param(1, 'fred'); $sth->execute(); $fetched = $sth->fetchrow_arrayref->[0]; is($fetched, 'fred', "rebound parameter correctly retrieved"); # 3 eval { $sth->bind_param(1, $obj); }; ok($@, "cannot bind a plain reference"); # 4 $sth = undef; } $dbh->disconnect; package Object; use overload '""' => 'to_s'; sub new() { bless { }, shift }; sub to_s() { my $self = shift; ref($self); }