| Subject: | [PATCH] fix warnings during global destruction |
Patch attached to remove annoying warnings during global destruction,
with tests.
OT: I still need to give you a patch for Cygwin 1.7, the patch I gave
you earlier is only good for earlier versions of Cygwin, but I'll
definitely work on this.
| Subject: | 0001-fix-warnings-in-global-destruction.patch |
From d7d7e0b2a81d1adf509cbdeddf25f665825a8a60 Mon Sep 17 00:00:00 2001
From: Rafael Kitover <rkitover@cpan.org>
Date: Tue, 8 Feb 2011 10:25:08 -0500
Subject: [PATCH] fix warnings in global destruction
---
lib/DBD/ADO.pm | 8 +++++++-
t/52glob_dest.t | 30 ++++++++++++++++++++++++++++++
t/glob_dest_warns.pl | 16 ++++++++++++++++
3 files changed, 53 insertions(+), 1 deletions(-)
create mode 100644 t/52glob_dest.t
create mode 100644 t/glob_dest_warns.pl
diff --git a/lib/DBD/ADO.pm b/lib/DBD/ADO.pm
index 82a7602..65284ee 100644
--- a/lib/DBD/ADO.pm
+++ b/lib/DBD/ADO.pm
@@ -222,7 +222,7 @@
my ( $dbh ) = @_;
my $conn = $dbh->{ado_conn};
- if ( defined $conn ) {
+ if ( defined $conn && defined $conn->State ) {
local $Win32::OLE::Warn = 0;
$dbh->trace_msg(' -- State: ' . $conn->State . "\n", 5 );
if ( $conn->State & $Enums->{ObjectStateEnum}{adStateOpen} ) {
@@ -988,6 +988,12 @@
sub DESTROY {
my ( $dbh ) = @_;
+
+ my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+ local $SIG{__WARN__} = sub {
+ $warn_handler->(@_) unless $_[0] =~ /Not a Win32::OLE object/
+ };
+
$dbh->disconnect if $dbh->FETCH('Active');
return;
}
diff --git a/t/52glob_dest.t b/t/52glob_dest.t
new file mode 100644
index 0000000..d0a5ec8
--- /dev/null
+++ b/t/52glob_dest.t
@@ -0,0 +1,30 @@
+#!perl -I./t
+
+use strict;
+use warnings;
+use DBI();
+use DBD_TEST();
+
+use Test::More;
+
+if (not defined $ENV{DBI_DSN}) {
+ plan skip_all => 'Cannot test without DB info';
+}
+
+eval "require Capture::Tiny;";
+if ($@) {
+ plan skip_all => 'Capture::Tiny required for this test';
+}
+
+plan tests => 1;
+
+my ($stdout, $stderr) = Capture::Tiny::capture(sub {
+ system $^X, '-w', 't/glob_dest_warns.pl';
+});
+
+ok((length $stdout == 0 && length $stderr == 0),
+ 'no warnings in global destruction')
+ or do {
+ diag 'STDOUT: ', $stdout;
+ diag 'STDERR: ', $stderr;
+};
diff --git a/t/glob_dest_warns.pl b/t/glob_dest_warns.pl
new file mode 100644
index 0000000..39bb884
--- /dev/null
+++ b/t/glob_dest_warns.pl
@@ -0,0 +1,16 @@
+#!C:\Perl\bin\perl -w
+use strict;
+use warnings;
+use DBI;
+use Carp;
+
+$SIG{__WARN__} = sub { confess $_[0] };
+
+my $dbh = DBI->connect;
+
+cleanup();
+
+sub cleanup {
+ $dbh->disconnect;
+ $dbh = DBI->connect;
+}
--
1.7.3.1