Author: byterock
Date: Wed Jul 14 05:13:03 2010
New Revision: 14242
Added:
dbd-oracle/trunk/t/36lob_leak.t
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.pm
Log:
New test and a few little patches
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Wed Jul 14 05:13:03 2010
@@ -1,13 +1,13 @@
=head1 Changes in DBD-Oracle 1.25(svn rev )
Added support for the OCIPing by John Scoles
- Spell checked the pod (the first time in a while me thinks) udated the todo By John Scoles
+ Spell checked the pod (the first time in a while me thinks) updated the todo By John Scoles
Added support for DCRP (Database Resident Connection Pooling) by John Scoles with Luben Karavelov
Fix for odd error with Ping from Tom Payerle
- Removed the NEW_OCI_INIT compile directive and the depricated OCIInitialize calls
+ Removed the NEW_OCI_INIT compile directive and the deprecated OCIInitialize calls
Fix for rt.cpan.org Ticket #=57256 : Double free problem in dbdimp.c by John Scoles
Fix for invalid format in trace of OCILobLocatorIsInit_log_stat reported by Martin Evans Fixed by John Scoles
- Fix for very odd UNKNOWN OCI STATUS 1041 (OCILobFreeTemporary) on disconnect reported by John Parker and Dob Mcgowan fixe by John Scoles
+ Fix for very odd UNKNOWN OCI STATUS 1041 (OCILobFreeTemporary) on disconnect reported by John Parker and Bob Mcgowan fixed by John Scoles
Fix for rt.cpan.org Ticket #=55445: get_info(28) SQL_IDENTIFIER_CASE seems to return the wrong value from Martin J Evans and a bunch of re jigging from John Scoles
Patch for PL/SQL: numeric or value error: character string buffer too small from Scott T. Hildreth
Fix for rt.cpan.org Ticket #=51594 type_info and type_info_all miss vital information from John Scoles
@@ -15,7 +15,7 @@
Fix for rt.cpan.org Ticket #=55031 Ubuntu Server Building with Oracle XE under 32-bit from Brian Candler
Fix for rt.cpan.org Ticket #=56810 bug with multiple nested cursor from John Scoles
Fix for bug found only on Big-Endian hardware reported by Timothy Everett and others from Charles Jardine
- Fix for memory leak when using prepared_cached and lobs reported by Mark Bobak and Martin Evans found and fixed by John Scoles
+ Fix for memory leak when using prepared_cached and lobs reported by Mark Bobak and Martin Evans found and fixed by John Scoles and a test from Martin Evans
Added more entries to the Readmes from John Scoles
=head1 Changes in DBD-Oracle 1.24_01(svn rev 14060)
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Wed Jul 14 05:13:03 2010
@@ -189,10 +189,10 @@
} split /\s*;\s*/, $dbname;
my %dbname = ( PROTOCOL => 'tcp', @dbname );
- if ($dbname{SERVER} eq "POOLED") {
+ if ((exists $dbname{SERVER}) and ($dbname{SERVER} eq "POOLED")) {
$attr->{ora_drcp}=1;
-
}
+
# extract main attributes for connect_data portion
my @connect_data_attr = qw(SID INSTANCE_NAME SERVER SERVICE_NAME );
my %connect_data = map { ($_ => delete $dbname{$_}) }
Added: dbd-oracle/trunk/t/36lob_leak.t
==============================================================================
--- (empty file)
+++ dbd-oracle/trunk/t/36lob_leak.t Wed Jul 14 05:13:03 2010
@@ -0,0 +1,163 @@
+#!perl -w
+
+##----------------------------------------------------------------------------
+## 36lob_leak.pl
+## By Martin Evans, Easysoft Limited
+##----------------------------------------------------------------------------
+## Test we are not leaking temporary lobs
+##----------------------------------------------------------------------------
+
+use Test::More;
+
+use DBI;
+use Config;
+use DBD::Oracle qw(:ora_types);
+use strict;
+use warnings;
+use Data::Dumper;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '');
+
+if ($dbh) {
+ plan tests => 7;
+} else {
+ plan skip_all => "Unable to connect to Oracle ($DBI::errstr)\nTests
+skipped.\n";
+}
+
+# get SID and cached lobs
+# if sid not passed in we run 2 tests, get the sid and the cached lobs
+# if sid passed in we run 1 test which is to get the cached lobs
+sub get_cached_lobs
+{
+ my ($dbh, $sid) = @_;
+ my $cached_lobs;
+
+ if (!defined($sid)) {
+ SKIP: {
+ eval {
+ ($sid) = $dbh->selectrow_array(
+ q/select sid from v$session where audsid =
+SYS_CONTEXT('userenv', 'sessionid')/);
+ };
+ skip 'unable to find sid', 2 if ($@ || !defined($sid));
+
+ pass("found sid $sid");
+ };
+ }
+ if (defined($sid)) {
+ SKIP: {
+ eval {
+ $cached_lobs = $dbh->selectrow_array(
+ q/select CACHE_LOBS from V$TEMPORARY_LOBS where sid
+= ?/, undef, $sid);
+ };
+ skip 'unable to find cached lobs', 1
+ if ($@ || !defined($cached_lobs));
+ pass("found $cached_lobs cached lobs");
+ };
+ }
+ return ($sid, $cached_lobs);
+}
+
+sub setup_test
+{
+ my ($h) = @_;
+ my ($sth, $ev);
+
+ my $fn = 'p_DBD_Oracle_drop_me';
+
+ my $createproc = << "EOT";
+CREATE OR REPLACE FUNCTION $fn(pc IN CLOB) RETURN NUMBER AS
+BEGIN
+ NULL;
+ RETURN 0;
+END;
+EOT
+
+ eval {$h->do($createproc);};
+ BAIL_OUT("Failed to create test function - $@") if $@;
+ pass("created test function");
+
+ return $fn;
+}
+
+sub call_func
+{
+ my ($dbh, $function, $how) = @_;
+
+ eval {
+ my $sth;
+ my $sql = qq/BEGIN ? := $function(?); END;/;
+ if ($how eq 'prepare') {
+ $sth = $dbh->prepare($sql) or die($dbh->errstr);
+ } elsif ($how eq 'prepare_cached') {
+ $sth = $dbh->prepare_cached($sql) or die($dbh->errstr);
+ } else {
+ BAIL_OUT("Unknown prepare type $how");
+ }
+ $sth->{RaiseError} = 1;
+
+ BAIL_OUT("Cannot prepare a call to $function") if !$sth;
+
+ my ($return, $clob);
+ $clob = 'x' x 1000;
+ $sth->bind_param_inout(1, \$return, 10);
+ $sth->bind_param(2, $clob, {ora_type => ORA_CLOB});
+ $sth->execute;
+ };
+ BAIL_OUT("Cannot call $function successfully") if $@;
+}
+
+
+my ($sid, $cached_lobs);
+my ($function);
+SKIP: {
+ ($sid, $cached_lobs) = get_cached_lobs($dbh); # 1 2
+ skip 'Cannot find sid/cached lobs', 5 if !defined($cached_lobs);
+
+ $function = setup_test($dbh); # 3
+ my $new_cached_lobs;
+
+ foreach my $type (qw(prepare prepare_cached)) {
+ for my $count(1..100) {
+ call_func($dbh, $function, $type);
+ };
+ ($sid, $new_cached_lobs) = get_cached_lobs($dbh, $sid);
+
+ # we expect to leak 1 temporary lob as the last statement is
+ # cached and the temp lob is not thrown away until you next
+ # execute
+ if ($new_cached_lobs > ($cached_lobs + 1)) {
+ diag("Looks like we might be leaking temporary lobs from
+$type");
+ fail("old cached lobs: $cached_lobs " .
+ "new cached lobs: $new_cached_lobs");
+ } else {
+ pass("Not leaking temporary lobs on $type");
+ }
+ $cached_lobs = $new_cached_lobs;
+ }
+
+};
+
+END {
+ if ($dbh) {
+ local $dbh->{PrintError} = 0;
+ local $dbh->{RaiseError} = 1;
+ eval {$dbh->do(qq/drop function $function/);};
+ if ($@) {
+ warn("function p_DBD_Oracle_drop_me possibly not dropped" .
+ "- check - $@\n") if $dbh->err ne '4043';
+ } else {
+ diag("function p_DBD_Oracle_drop_me dropped");
+ }
+ }
+}
\ No newline at end of file
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.