[svn:dbd-oracle] r14956 - in dbd-oracle/branches/DBD-Oracle-1.33_00: . t
[email protected] Tue, 18 Oct 2011 10:23:52 -0700 (PDT)
| Newsgroups | perl.dbd.oracle.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: yanick
Date: Tue Oct 18 10:23:52 2011
New Revision: 14956
Added:
dbd-oracle/branches/DBD-Oracle-1.33_00/t/36lob_leak.t
Modified:
dbd-oracle/branches/DBD-Oracle-1.33_00/Changes
dbd-oracle/branches/DBD-Oracle-1.33_00/Makefile.PL
dbd-oracle/branches/DBD-Oracle-1.33_00/Oracle.pm
dbd-oracle/branches/DBD-Oracle-1.33_00/t/01base.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/10general.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/15nls.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/20select.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/22nchar_utf8.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db_al32utf8.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/24implicit_utf8.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/25plsql.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/31lob_extended.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/40ph_type.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/50cursor.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/55nested.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/70meta.t
dbd-oracle/branches/DBD-Oracle-1.33_00/t/nchar_test_lib.pl
Log:
v1.33_00
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/Changes
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/Changes (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/Changes Tue Oct 18 10:23:52 2011
@@ -1,7 +1,18 @@
Revision history for DBD::Oracle
+Changes in DBD-Oracle 1.33_00 (18-10-2011)
+
+ [BUG FIXES]
+ - COLUMN_SIZE of VARCHAR2 returns size in chars, not bytes. [RT#13865]
+ (reported by Stefano and Laurent Dami)
+
+ [DOCUMENTATION]
+ - add mention of the github mirror of the subversion repository
+ - add 'resources' info to META.yml
+ - fixed broken link to Oracle DRCP doc in POD (John Scoles)
Changes in DBD-Oracle 1.32 (16-10-2011)
+
- promote 1.31_00 to official release
Changes in DBD-Oracle 1.31_00
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/Makefile.PL
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/Makefile.PL (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/Makefile.PL Tue Oct 18 10:23:52 2011
@@ -62,7 +62,20 @@
configure_requires => { "DBI" => '1.51' },
build_requires => {"DBI" => '1.51',
"ExtUtils::MakeMaker" => 0,
- "Test::Simple" => '0.90'}
+ "Test::Simple" => '0.90'},
+ resources => {
+ bugtracker => {
+ mailto => 'bug-dbd-oracle at rt.cpan.org',
+ web =>
+ 'http://rt.cpan.org/Public/Dist/Display.html?Name=DBD-Oracle',
+ },
+ homepage => 'http://search.cpan.org/dist/DBD-Oracle',
+ repository => {
+ type => 'git',
+ url => 'git://github.com/yanick/DBD-Oracle.git',
+ web => 'http://github.com/yanick/DBD-Oracle/tree',
+ },
+ },
},
);
my $eumm = $ExtUtils::MakeMaker::VERSION;
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/Oracle.pm
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/Oracle.pm (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/Oracle.pm Tue Oct 18 10:23:52 2011
@@ -7,7 +7,7 @@
require 5.006;
-$DBD::Oracle::VERSION = '1.32';
+$DBD::Oracle::VERSION = '1.33_00';
my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
@@ -650,6 +650,7 @@
)
, 'FLOAT' , tc.DATA_PRECISION
, 'DATE' , 19
+ , 'VARCHAR2' , tc.CHAR_LENGTH
, tc.DATA_LENGTH
) COLUMN_SIZE
, decode( tc.DATA_TYPE
@@ -1532,7 +1533,7 @@
$dbh = DBI->connect('dbi:Oracle:DB','username','password')
-You can find a white paper on setting up DRCP and its advantages at L<http://www.oracle.com/technology/tech/oci/pdf/oracledrcp11g.pdf>.
+You can find a white paper on setting up DRCP and its advantages at L<http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf>.
Please note that DRCP support in DBD::Oracle is relatively new so the
mechanics or its implementation are subject to change.
@@ -5551,6 +5552,11 @@
of them being rejected because they don't fit into some larger plans
you may not be aware of.
+=head2 GitHub repository
+
+A git mirror of the subversion is also available at
+`https://github.com/yanick/DBD-Oracle`.
+
=head1 Oracle Related Links
=head2 DBD::Oracle Tutorial
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/01base.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/01base.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/01base.t Tue Oct 18 10:23:52 2011
@@ -3,8 +3,7 @@
# Base DBD Driver Test
use Test::More tests => 6;
-diag('Test loading DBI, DBD::Oracle and version');
-require_ok(DBI);
+require_ok('DBI');
eval {
import DBI;
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/10general.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/10general.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/10general.t Tue Oct 18 10:23:52 2011
@@ -13,8 +13,6 @@
$| = 1;
-diag('Test preparsing, Active, NLS_NUMERIC_CHARACTERS, err, ping and OCI version');
-
my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
@@ -105,10 +103,10 @@
ok( $dbh->ping, 'ping - connected');
my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar
-printf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci;
+note sprintf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci;
+
ok("$ora_oci", 'ora_oci defined');
-ok($ora_oci >= 8, 'ora_oci >= 8');
-diag($ora_oci);
+ok($ora_oci >= 8, "ora_oci $ora_oci >= 8");
my @ora_oci = split(/\./, $ora_oci,-1);
ok(scalar @ora_oci >= 2, 'version has 2 or more components');
ok((scalar @ora_oci == grep { DBI::looks_like_number($_) } @ora_oci),
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/15nls.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/15nls.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/15nls.t Tue Oct 18 10:23:52 2011
@@ -12,7 +12,6 @@
$| = 1;
-diag('test nls_date_format, ora_can_unicode');
my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/20select.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/20select.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/20select.t Tue Oct 18 10:23:52 2011
@@ -44,7 +44,8 @@
plan skip_all => "Unable to connect to oracle\n";
}
-diag('test simple select statements with [utf8]');
+# test simple select statements with [utf8]
+
my $utf8_test = ($] >= 5.006)
&& client_ochar_is_utf8() # for correct output (utf8 bind vars should be fine regardless)
&& ($dbh->ora_can_unicode() & 2);
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/22nchar_utf8.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/22nchar_utf8.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/22nchar_utf8.t Tue Oct 18 10:23:52 2011
@@ -24,14 +24,15 @@
plan skip_all => "Unable to connect to Oracle" if not $dbh;
plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ;
- diag("testing utf8 with nchar columns\n");
+
+ # testing utf8 with nchar columns
show_db_charsets( $dbh );
my $tdata = test_data( 'wide_nchar' );
if ( $dbh->ora_can_unicode & 1 ) {
push( @{$tdata->{rows}} ,extra_wide_rows() ) ;
- diag(" --- added 2 rows with extra wide chars to test data\n");
+ # added 2 rows with extra wide chars to test data
}
my $testcount = 0 #create table
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db.t Tue Oct 18 10:23:52 2011
@@ -27,7 +27,8 @@
plan skip_all => "Unable to connect to Oracle" if not $dbh;
plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ;
- print "testing utf8 with char columns (wide mode database)\n" ;
+
+ # testing utf8 with char columns (wide mode database)
my $tdata = test_data( 'wide_char' );
my $testcount = 0 #create table
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db_al32utf8.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db_al32utf8.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/23wide_db_al32utf8.t Tue Oct 18 10:23:52 2011
@@ -25,7 +25,7 @@
plan skip_all => "Unable to connect to Oracle" if not $dbh;
plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ;
- diag("testing utf8 with char columns (wide mode database)\n") ;
+ # testing utf8 with char columns (wide mode database)
my $tdata = test_data( 'wide_char' );
my $testcount = 0 #create table
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/24implicit_utf8.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/24implicit_utf8.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/24implicit_utf8.t Tue Oct 18 10:23:52 2011
@@ -25,7 +25,7 @@
plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ;
$dbh->disconnect();
- diag(" --- testing implicit csform (dbhimp.c sets csform implicitly)\n") ;
+ # testing implicit csform (dbhimp.c sets csform implicitly)
my $tdata = test_data( 'wide_nchar' );
my $testcount = 0
+ insert_test_count( $tdata )
@@ -39,7 +39,7 @@
foreach my $nchar_cset (@nchar_cset) {
$dbh->disconnect() if $dbh;
undef $dbh;
- diag(" --- testing with NLS_NCHAR=$nchar_cset\n") ;
+ # testing with NLS_NCHAR=$nchar_cset
SKIP: {
set_nls_nchar( $nchar_cset ,1 );
$dbh = db_handle();
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/25plsql.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/25plsql.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/25plsql.t Tue Oct 18 10:23:52 2011
@@ -261,10 +261,9 @@
is("@r", "@s2", "ref = sql");
}
-diag("test bind_param_inout of param that's not assigned to in executed statement\n");
+# test bind_param_inout of param that's not assigned to in executed statement
# See http://www.mail-archive.com/[email protected]/msg18835.html
-if (1) {
- my $sth = $dbh->prepare (q(
+my $sth = $dbh->prepare (q(
BEGIN
-- :p1 := :p1 ;
-- :p2 := :p2 ;
@@ -272,21 +271,23 @@
:p1 := 'AAA' ;
:p2 := 'Z' ;
END IF ;
- END ;));
+END ;));
+
+{
my ($p1, $p2, $p3) = ('Hello', 'Y', 'Y') ;
$sth->bind_param_inout(':p1', \$p1, 30) ;
$sth->bind_param_inout(':p2', \$p2, 1) ;
$sth->bind_param_inout(':p3', \$p3, 1) ;
- diag("Before p1=[$p1] p2=[$p2] p3=[$p3]\n");
+ note("Before p1=[$p1] p2=[$p2] p3=[$p3]\n");
ok($sth->execute, 'test bind_param_inout for non assigned');
is($p1, 'Hello', 'p1 ok');
is($p2, 'Y', 'p2 ok');
is($p3, 'Y', 'p3 ok');
- diag("After p1=[$p1] p2=[$p2] p3=[$p3]\n");
+ note("After p1=[$p1] p2=[$p2] p3=[$p3]\n");
}
SKIP: {
- diag("test nvarchar2 arg passing to functions\n");
+ # test nvarchar2 arg passing to functions
# http://www.nntp.perl.org/group/perl.dbi.users/24217
my $ora_server_version = $dbh->func("ora_server_version");
skip "Client/server version < 9.0", 15
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/31lob_extended.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/31lob_extended.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/31lob_extended.t Tue Oct 18 10:23:52 2011
@@ -171,24 +171,21 @@
}
END {
- if ($dbh) {
- local $dbh->{PrintError} = 0;
- local $dbh->{RaiseError} = 1;
- eval {$dbh->do(q/drop procedure p_DBD_Oracle_drop_me/);};
- if ($@) {
- warn("procedure p_DBD_Oracle_drop_me possibly not dropped" .
- "- check - $@\n") if $dbh->err ne '4043';
- } else {
- diag("procedure p_DBD_Oracle_drop_me dropped");
- }
- eval {drop_table($dbh);};
- if ($@) {
- warn("table $table possibly not dropped - check - $@\n")
+ return unless $dbh;
- if $dbh->err ne '942';
- } else {
- diag("table $table dropped");
- }
+ local $dbh->{PrintError} = 0;
+ local $dbh->{RaiseError} = 1;
+
+ eval {$dbh->do(q/drop procedure p_DBD_Oracle_drop_me/);};
+ if ($@) {
+ diag("procedure p_DBD_Oracle_drop_me possibly not dropped" .
+ "- check - $@\n") if $dbh->err ne '4043';
+ }
+
+ eval {drop_table($dbh);};
+ if ($@) {
+ diag("table $table possibly not dropped - check - $@\n")
+ if $dbh->err ne '942';
}
-};
+}
Added: dbd-oracle/branches/DBD-Oracle-1.33_00/t/36lob_leak.t
==============================================================================
--- (empty file)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/36lob_leak.t Tue Oct 18 10:23:52 2011
@@ -0,0 +1,167 @@
+#!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, '',,{
+ 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';
+
+ 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;
+ if ($function){
+ eval {$dbh->do(qq/drop function $function/);};
+ if ($@) {
+ diag("function p_DBD_Oracle_drop_me possibly not dropped" .
+ "- check - $@\n") if $dbh->err ne '4043';
+ } else {
+ note("function p_DBD_Oracle_drop_me dropped");
+ }
+ }
+ }
+}
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/40ph_type.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/40ph_type.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/40ph_type.t Tue Oct 18 10:23:52 2011
@@ -100,9 +100,9 @@
$expect =~ s/\s+$// if $test_info->{chops_space};
my $ok = ($tmp->{ts}->{vc} eq $expect);
if (!$ok && $ph_type==1 && $name eq 'VARCHAR2') {
- warn " Placeholder behaviour for ora_type=1 VARCHAR2 (the default) varies with Oracle version.\n";
- warn " Oracle 7 didn't strip trailing spaces, Oracle 8 did, until 9.2.x\n";
- warn " Your system doesn't. If that seems odd, let us know.\n";
+ note " Placeholder behaviour for ora_type=1 VARCHAR2 (the default) varies with Oracle version.\n"
+ . " Oracle 7 didn't strip trailing spaces, Oracle 8 did, until 9.2.x\n"
+ . " Your system doesn't. If that seems odd, let us know.\n";
$ok = 1;
}
ok($ok, sprintf(" using ora_type %d expected %s but got %s for $name",
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/50cursor.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/50cursor.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/50cursor.t Tue Oct 18 10:23:52 2011
@@ -41,7 +41,8 @@
plan tests => $tests;
- diag("Max cursors: $limit\n");
+ note "Max cursors: $limit";
+
} else {
plan skip_all => "Unable to connect to Oracle";
}
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/55nested.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/55nested.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/55nested.t Tue Oct 18 10:23:52 2011
@@ -89,7 +89,9 @@
my $tm_start = DBI::dbi_time();
$row_count++ while $rs->fetch;
my $elapsed = DBI::dbi_time() - $tm_start;
- diag("Fetched $row_count rows ($caption): $elapsed secs.\n");
+
+ note "Fetched $row_count rows ($caption): $elapsed secs.";
+
return $elapsed;
}
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/70meta.t
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/70meta.t (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/70meta.t Tue Oct 18 10:23:52 2011
@@ -38,20 +38,19 @@
foreach my $table_info_params (@table_info_params) {
my ($name) = shift @$table_info_params;
my $start = time;
- diag("$name: table_info(".DBI::neat_list($table_info_params).")\n");
+ note("$name: table_info(".DBI::neat_list($table_info_params).")\n");
my $table_info_sth = $dbh->table_info(@$table_info_params);
ok($table_info_sth, 'table_info');
my $data = $table_info_sth->fetchall_arrayref;
ok($data, 'table_info fetch');
ok(scalar @$data, 'table_info data returned');
my $dur = time - $start;
- diag("$name: ".@$data." rows, $dur seconds\n");
-# print Dumper($data);
+ note("$name: ".@$data." rows, $dur seconds\n");
}
my $sql_dbms_version = $dbh->get_info(18);
ok($sql_dbms_version, 'dbms_version');
-diag("sql_dbms_version=$sql_dbms_version\n");
+note "sql_dbms_version=$sql_dbms_version";
like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched');
$dbh->disconnect;
Modified: dbd-oracle/branches/DBD-Oracle-1.33_00/t/nchar_test_lib.pl
==============================================================================
--- dbd-oracle/branches/DBD-Oracle-1.33_00/t/nchar_test_lib.pl (original)
+++ dbd-oracle/branches/DBD-Oracle-1.33_00/t/nchar_test_lib.pl Tue Oct 18 10:23:52 2011
@@ -444,7 +444,7 @@
# see comments in dbdimp.c for details.
DBD::Oracle::ora_cygwin_set_env('NLS_NCHAR', $ENV{NLS_NCHAR}||'')
if $^O eq 'cygwin';
- diag(defined ora_env_var("NLS_NCHAR") ? # defined?
+ note(defined ora_env_var("NLS_NCHAR") ? # defined?
"set \$ENV{NLS_NCHAR}=$cset\n" :
"set \$ENV{NLS_LANG}=undef\n") # XXX ?
if defined $verbose;
@@ -453,17 +453,15 @@
sub set_nls_lang_charset
{
my ($lang,$verbose) = @_;
- if ( $lang ) {
- $ENV{NLS_LANG} = "AMERICAN_AMERICA.$lang";
- diag("set \$ENV{NLS_LANG}=AMERICAN_AMERICA.$lang\n") if ( $verbose );
- } else {
- $ENV{NLS_LANG} = ""; # not the same as set_nls_nchar() above which uses undef
- diag("set \$ENV{NLS_LANG}=''\n") if ( $verbose );
- }
+
+ $ENV{NLS_LANG} = $lang ? "AMERICAN_AMERICA.$lang" : '';
+
+ note "set \$ENV{NLS_LANG='$ENV{NLS_LANG}'";
+
# Special treatment for environment variables under Cygwin -
# see comments in dbdimp.c for details.
DBD::Oracle::ora_cygwin_set_env('NLS_LANG', $ENV{NLS_LANG}||'')
- if $^O eq 'cygwin';
+ if $^O eq 'cygwin';
}
sub byte_string {