1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
#!perl
use strict;
use warnings;
use lib 't/lib';
use DBDOracleTestLib qw/ oracle_test_dsn db_handle /;
##----------------------------------------------------------------------------
## 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);
$| = 1;
my $dbh = db_handle( { PrintError => 0 });
if ($dbh) {
plan tests => 7;
}
else {
$dbh->{PrintError} = 1;
plan skip_all => 'Unable to connect to Oracle';
}
# 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' . ( $ENV{DBD_ORACLE_SEQ} || '' );
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 and not $ENV{DBD_SKIP_TABLE_DROP}) {
local $dbh->{PrintError} = 0;
local $dbh->{RaiseError} = 1;
if ($function) {
eval { $dbh->do(qq/drop function $function/); };
if ($@) {
diag( "function '$function' possibly not dropped"
. "- check - $@\n" )
if $dbh->err ne '4043';
}
else {
note("function '$function' dropped");
}
}
}
}
|
