Hello community,
here is the log from the commit of package perl-Devel-Confess for
openSUSE:Factory checked in at 2015-02-08 11:42:59
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Devel-Confess (Old)
and /work/SRC/openSUSE:Factory/.perl-Devel-Confess.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Devel-Confess"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Devel-Confess/perl-Devel-Confess.changes
2014-09-17 17:26:46.000000000 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Devel-Confess.new/perl-Devel-Confess.changes
2015-02-08 11:43:00.000000000 +0100
@@ -1,0 +2,41 @@
+Sat Feb 7 16:23:04 UTC 2015 - [email protected]
+
+- updated to 0.007011
+ - avoid triggering overloads when CLONEing
+
+ 0.007010 - 2015-01-29
+ - fix incorrect version check that prevented using better names option
+ - fix removing hooks when unimport called
+ - fix stringifying refs in stack trace inside a Safe compartment on old perl
+ - avoid updating stored refaddrs when they haven't changed
+ - less noise when checking for broken threads
+ - prevent leaking namespaces even in broken threads
+ - fix version check for broken threads
+
+ 0.007009 - 2015-01-23
+ - prevent segfaults on perl 5.10.0 and 5.8.9 with threads
+ - fix leaking exception objects if another is thrown or a thread created
+
+ 0.007008 - 2015-01-20
+ - don't attempt threading tests if threading is broken
+
+ 0.007007 - 2015-01-19
+ - fatal warnings in destructors can cause segfaults, so disable them
+ - protect against losing information during global destruction and then
+ triggering our own errors
+ - improve stack trace formatting when generated during global destruction
+
+ 0.007006 - 2015-01-08
+ - don't delete packages that exceptions are currently blessed as
+ - protect tests against other loaded modules effecting hooks
+ - add test for warning passing fix from 0.007005
+
+ 0.007005 - 2014-12-16
+ - fix how we pass options on to other warn/die handlers (RT#100951)
+ - minor pod cleanups
+ - improve diagnostics for bad options in DEVEL_CONFESS_OPTIONS
+
+ 0.007004 - 2014-09-22
+ - make sure unwanted debugging flags are disabled as early as possible,
+
+-------------------------------------------------------------------
Old:
----
Devel-Confess-0.007003.tar.gz
New:
----
Devel-Confess-0.007011.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Devel-Confess.spec ++++++
--- /var/tmp/diff_new_pack.97QrS8/_old 2015-02-08 11:43:01.000000000 +0100
+++ /var/tmp/diff_new_pack.97QrS8/_new 2015-02-08 11:43:01.000000000 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Devel-Confess
#
-# Copyright (c) 2014 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-Devel-Confess
-Version: 0.007003
+Version: 0.007011
Release: 0
%define cpan_name Devel-Confess
Summary: Include stack traces on all warnings and errors
++++++ Devel-Confess-0.007003.tar.gz -> Devel-Confess-0.007011.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/Changes
new/Devel-Confess-0.007011/Changes
--- old/Devel-Confess-0.007003/Changes 2014-07-26 22:32:36.000000000 +0200
+++ new/Devel-Confess-0.007011/Changes 2015-02-03 17:04:01.000000000 +0100
@@ -1,5 +1,44 @@
Release history for Devel-Confess
+0.007011 - 2015-02-03
+ - avoid triggering overloads when CLONEing
+
+0.007010 - 2015-01-29
+ - fix incorrect version check that prevented using better names option
+ - fix removing hooks when unimport called
+ - fix stringifying refs in stack trace inside a Safe compartment on old perl
+ - avoid updating stored refaddrs when they haven't changed
+ - less noise when checking for broken threads
+ - prevent leaking namespaces even in broken threads
+ - fix version check for broken threads
+
+0.007009 - 2015-01-23
+ - prevent segfaults on perl 5.10.0 and 5.8.9 with threads
+ - fix leaking exception objects if another is thrown or a thread created
+
+0.007008 - 2015-01-20
+ - don't attempt threading tests if threading is broken
+
+0.007007 - 2015-01-19
+ - fatal warnings in destructors can cause segfaults, so disable them
+ - protect against losing information during global destruction and then
+ triggering our own errors
+ - improve stack trace formatting when generated during global destruction
+
+0.007006 - 2015-01-08
+ - don't delete packages that exceptions are currently blessed as
+ - protect tests against other loaded modules effecting hooks
+ - add test for warning passing fix from 0.007005
+
+0.007005 - 2014-12-16
+ - fix how we pass options on to other warn/die handlers (RT#100951)
+ - minor pod cleanups
+ - improve diagnostics for bad options in DEVEL_CONFESS_OPTIONS
+
+0.007004 - 2014-09-22
+ - make sure unwanted debugging flags are disabled as early as possible,
+ fixing several possible crashes
+
0.007003 - 2014-07-26
- fix leak test on new versions of Test::More
- prevent PAUSE from trying (and failing) to index an internal package
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/MANIFEST
new/Devel-Confess-0.007011/MANIFEST
--- old/Devel-Confess-0.007003/MANIFEST 2014-07-26 22:32:47.000000000 +0200
+++ new/Devel-Confess-0.007011/MANIFEST 2015-02-03 17:04:24.000000000 +0100
@@ -10,11 +10,15 @@
t/confess.t
t/devel.t
t/dump.t
+t/global-destruct.t
t/leak.t
t/lib/capture.pm
+t/lib/threads_check.pm
+t/names.t
t/safe.t
t/sig.t
t/source.t
+t/threads.t
xt/builtin.t
META.yml Module YAML meta-data (added by
MakeMaker)
META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/META.json
new/Devel-Confess-0.007011/META.json
--- old/Devel-Confess-0.007003/META.json 2014-07-26 22:32:47.000000000
+0200
+++ new/Devel-Confess-0.007011/META.json 2015-02-03 17:04:24.000000000
+0100
@@ -4,7 +4,7 @@
"haarg - Graham Knop (cpan:HAARG) <[email protected]>"
],
"dynamic_config" : 0,
- "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter
version 2.141520",
+ "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter
version 2.142690",
"license" : [
"perl_5"
],
@@ -65,5 +65,5 @@
"web" : "https://github.com/haarg/Devel-Confess";
}
},
- "version" : "0.007003"
+ "version" : "0.007011"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/META.yml
new/Devel-Confess-0.007011/META.yml
--- old/Devel-Confess-0.007003/META.yml 2014-07-26 22:32:46.000000000 +0200
+++ new/Devel-Confess-0.007011/META.yml 2015-02-03 17:04:24.000000000 +0100
@@ -8,7 +8,7 @@
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version
2.141520'
+generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version
2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -26,4 +26,4 @@
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Confess
license: http://dev.perl.org/licenses/
repository: git://github.com/haarg/Devel-Confess
-version: '0.007003'
+version: '0.007011'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/Makefile.PL
new/Devel-Confess-0.007011/Makefile.PL
--- old/Devel-Confess-0.007003/Makefile.PL 2014-04-29 19:13:59.000000000
+0200
+++ new/Devel-Confess-0.007011/Makefile.PL 2014-08-18 21:32:56.000000000
+0200
@@ -47,7 +47,7 @@
my %MM_ARGS = ();
-##############################################################################
+## BOILERPLATE ###############################################################
require ExtUtils::MakeMaker;
(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
@@ -58,8 +58,10 @@
($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g;
($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g;
-$MM_ARGS{LICENSE} = $META{license}
- if $eumm_version >= 6.30;
+$META{license} = [ $META{license} ]
+ if $META{license} && !ref $META{license};
+$MM_ARGS{LICENSE} = $META{license}[0]
+ if $META{license} && $eumm_version >= 6.30;
$MM_ARGS{NO_MYMETA} = 1
if $mymeta_broken;
$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
@@ -68,7 +70,7 @@
for (qw(configure build test runtime)) {
my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES';
my $r = $MM_ARGS{$key} = {
- %{$META{prereqs}{$_}{requires}},
+ %{$META{prereqs}{$_}{requires} || {}},
%{delete $MM_ARGS{$key} || {}},
};
defined $r->{$_} or delete $r->{$_} for keys %$r;
@@ -86,3 +88,4 @@
if $eumm_version < 6.51_03;
ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS);
+## END BOILERPLATE ###########################################################
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/README
new/Devel-Confess-0.007011/README
--- old/Devel-Confess-0.007003/README 2014-07-26 22:32:47.000000000 +0200
+++ new/Devel-Confess-0.007011/README 2015-02-03 17:04:24.000000000 +0100
@@ -57,7 +57,7 @@
METHODS
import( @options )
Enables stack traces and sets options. A list of options to enable can
- be passed in. Prefixing the options with no_ will disable them.
+ be passed in. Prefixing the options with "no_" will disable them.
"objects"
Enable attaching stack traces to exception objects. Enabled by
@@ -141,9 +141,9 @@
around with "warn", "die", $SIG{'__WARN__'}, $SIG{'__DIE__'}.
AUTHORS
- * Graham Knop, <[email protected]>
+ * Graham Knop <[email protected]>
- * Adriano Ferreira, <[email protected]>
+ * Adriano Ferreira <[email protected]>
CONTRIBUTORS
None yet.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/lib/Devel/Confess/Builtin.pm
new/Devel-Confess-0.007011/lib/Devel/Confess/Builtin.pm
--- old/Devel-Confess-0.007003/lib/Devel/Confess/Builtin.pm 2014-07-26
22:31:58.000000000 +0200
+++ new/Devel-Confess-0.007011/lib/Devel/Confess/Builtin.pm 2015-02-03
17:03:35.000000000 +0100
@@ -3,19 +3,10 @@
use warnings FATAL => 'all';
no warnings 'once';
-our $VERSION = '0.007003';
+our $VERSION = '0.007011';
$VERSION = eval $VERSION;
-{
- our $gd;
- sub _global_destruction () {
- if (!$gd) {
- local $SIG{__WARN__} = sub { $gd = $_[0] =~ /global destruction\.\n\z/ };
- warn 1;
- }
- $gd;
- }
-}
+use Devel::Confess::_Util ();
{
package #hide
@@ -24,7 +15,7 @@
sub new { bless [@_[1 .. $#_]], $_[0] }
sub DESTROY {
return
- if Devel::Confess::Builtin::_global_destruction;
+ if Devel::Confess::_Util::_global_destruction;
$_->() for @{$_[0]}
}
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/lib/Devel/Confess/_Util.pm
new/Devel-Confess-0.007011/lib/Devel/Confess/_Util.pm
--- old/Devel-Confess-0.007003/lib/Devel/Confess/_Util.pm 2014-07-16
08:16:23.000000000 +0200
+++ new/Devel-Confess-0.007011/lib/Devel/Confess/_Util.pm 2015-01-26
05:27:39.000000000 +0100
@@ -6,11 +6,11 @@
use base 'Exporter';
-our @EXPORT = qw(blessed refaddr weaken longmess);
+our @EXPORT = qw(blessed refaddr weaken longmess _str_val);
use Carp ();
use Carp::Heavy ();
-use Scalar::Util qw(blessed refaddr);
+use Scalar::Util qw(blessed refaddr reftype);
# fake weaken if it isn't available. will cause leaks, but this
# is a brute force debugging tool, so we can deal with it.
@@ -81,4 +81,39 @@
} or die $@;
}
+*_str_val = eval q{
+ sub {
+ no overloading;
+ "$_[0]";
+ };
+} || eval q{
+ sub {
+ my $class = blessed($_[0]);
+ return "$_[0]" unless defined $class;
+ return sprintf("%s=%s(0x%x)", &blessed, &reftype, &refaddr);
+ };
+};
+
+{
+ if (defined ${^GLOBAL_PHASE}) {
+ eval q{
+ sub _global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] };
+ 1;
+ } or die $@;
+ }
+ else {
+ eval q{
+ our $gd;
+ sub _global_destruction () {
+ if (!$gd) {
+ local $SIG{__WARN__} = sub { $gd = $_[0] =~ /global
destruction\.\n\z/ };
+ warn 1;
+ }
+ $gd;
+ }
+ 1;
+ } or die $@;
+ }
+}
+
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/lib/Devel/Confess.pm
new/Devel-Confess-0.007011/lib/Devel/Confess.pm
--- old/Devel-Confess-0.007003/lib/Devel/Confess.pm 2014-07-26
22:31:51.000000000 +0200
+++ new/Devel-Confess-0.007011/lib/Devel/Confess.pm 2015-02-03
17:03:35.000000000 +0100
@@ -1,18 +1,6 @@
package Devel::Confess;
-use 5.006;
-use strict;
-use warnings FATAL => 'all';
-
-our $VERSION = '0.007003';
-$VERSION = eval $VERSION;
-
-use Carp ();
-use Symbol ();
-use Devel::Confess::_Util qw(blessed refaddr weaken longmess);
-BEGIN { *_can = \&UNIVERSAL::can; }
-
BEGIN {
- my $can_use_informative_names = $] >= 5.8;
+ my $can_use_informative_names = $] >= 5.008;
# detect -d:Confess. disable debugger features for now. we'll
# enable them when we need them.
if (!defined &DB::DB && $^P & 0x02) {
@@ -21,8 +9,26 @@
}
*_CAN_USE_INFORMATIVE_NAMES
= $can_use_informative_names ? sub () { 1 } : sub () { 0 };
+ *_BROKEN_CLONED_DESTROY_REBLESS
+ = ($] >= 5.008009 && $] < 5.010000) ? sub () { 1 } : sub () { 0 };
+ *_BROKEN_CLONED_GLOB_UNDEF
+ = ($] > 5.008009 && $] <= 5.010000) ? sub () { 1 } : sub () { 0 };
+ *_BROKEN_SIG_DELETE
+ = ($] < 5.008008) ? sub () { 1 } : sub () { 0 };
}
+use 5.006;
+use strict;
+use warnings;
+
+our $VERSION = '0.007011';
+$VERSION = eval $VERSION;
+
+use Carp ();
+use Symbol ();
+use Devel::Confess::_Util qw(blessed refaddr weaken longmess _str_val);
+BEGIN { *_can = \&UNIVERSAL::can; }
+
$Carp::Internal{+__PACKAGE__}++;
our %NoTrace;
@@ -49,7 +55,7 @@
_parse_options(
grep length, split /[\s,]+/, $ENV{DEVEL_CONFESS_OPTIONS}||''
);
- } or warn $@;
+ } or warn "DEVEL_CONFESS_OPTIONS: $@";
}
for my $opt (@opts) {
if ($opt->[1] =~ /^dump(\d*)$/) {
@@ -66,7 +72,7 @@
1;
}
-my %OLD_SIG;
+our %OLD_SIG;
sub import {
my $class = shift;
@@ -110,15 +116,27 @@
}
sub unimport {
- return
- unless keys %OLD_SIG;
- for (qw(__DIE__ __WARN__)) {
- my $sig = delete $OLD_SIG{$_};
- if (defined $sig) {
- $SIG{$_} = $sig;
+ for my $sig (
+ [ __DIE__ => \&_die ],
+ [ __WARN__ => \&_warn ],
+ ) {
+ my ($name, $sub) = @$sig;
+ my $now = $SIG{$name} or next;
+ my $old = $OLD_SIG{$name};
+ if ($now ne $sub && $old) {
+ local $SIG{__WARN__};
+ warn "Can't restore $name handler!\n";
+ delete $SIG{$sig};
+ }
+ elsif ($old) {
+ $SIG{$name} = $old;
+ delete $OLD_SIG{$name};
}
else {
- delete $SIG{$_};
+ no warnings 'uninitialized'; # bogus warnings on perl < 5.8.8
+ undef $SIG{$name}
+ if _BROKEN_SIG_DELETE;
+ delete $SIG{$name};
}
}
}
@@ -138,9 +156,10 @@
}
sub _warn {
+ local $SIG{__WARN__};
my @convert = _convert(@_);
if (my $warn = _find_sig($OLD_SIG{__WARN__})) {
- $warn->(@convert);
+ $warn->(join('', @convert));
}
else {
_colorize(\@convert, 33) if $OPTIONS{color};
@@ -151,7 +170,7 @@
local $SIG{__DIE__};
my @convert = _convert(@_);
if (my $sig = _find_sig($OLD_SIG{__DIE__})) {
- $sig->(@convert);
+ $sig->(join('', @convert));
}
_colorize(\@convert, 31) if $OPTIONS{color} && !$^S;
die @convert;
@@ -188,8 +207,8 @@
sub _stack_trace {
no warnings 'once';
- local $Carp::RefArgFormatter = \&_ref_formatter
- if $OPTIONS{dump};
+ local $Carp::RefArgFormatter
+ = $OPTIONS{dump} ? \&_ref_formatter : \&_str_val;
my $message = &longmess;
$message =~ s/\.?$/./m;
if ($OPTIONS{source}) {
@@ -198,15 +217,42 @@
$message;
}
-my $pack_suffix = 'A000';
-my %attached;
+our $PACK_SUFFIX = 'A000';
+
+our %EXCEPTIONS;
+our %PACKAGES;
+our %MESSAGES;
+our %CLONED;
sub CLONE {
- %attached = map { $_->[0] ? (refaddr($_->[0]) => $_) : () } values %attached;
+ my %id_map = map {
+ my $ex = $EXCEPTIONS{$_};
+ defined $ex ? ($_ => refaddr($ex)) : ();
+ } keys %EXCEPTIONS;
+
+ %EXCEPTIONS = map {; $id_map{$_} => $EXCEPTIONS{$_}} keys %id_map;
+ %PACKAGES = map {; $id_map{$_} => $PACKAGES{$_}} keys %id_map;
+ %MESSAGES = map {; $id_map{$_} => $MESSAGES{$_}} keys %id_map;
+ %CLONED = map {; $_ => 1 } values %id_map
+ if _BROKEN_CLONED_DESTROY_REBLESS || _BROKEN_CLONED_GLOB_UNDEF;
+ weaken($_)
+ for values %EXCEPTIONS;
+}
+
+sub _update_ex_refs {
+ for my $id ( keys %EXCEPTIONS ) {
+ next
+ if $EXCEPTIONS{$id};
+ delete $EXCEPTIONS{$id};
+ delete $PACKAGES{$id};
+ delete $MESSAGES{$id};
+ delete $CLONED{$id}
+ if _BROKEN_CLONED_DESTROY_REBLESS || _BROKEN_CLONED_GLOB_UNDEF;
+ }
}
sub _convert {
- CLONE;
+ _update_ex_refs;
if (my $class = blessed(my $ex = $_[0])) {
return @_
unless $OPTIONS{objects};
@@ -214,14 +260,15 @@
if ! do {no strict 'refs'; defined
&{"Devel::Confess::_Attached::DESTROY"} };
my $message;
my $id = refaddr($ex);
- if ($attached{$id}) {
+ if ($EXCEPTIONS{$id}) {
return @_
if $ex->isa("Devel::Confess::_Attached");
# something is going very wrong. possibly from a Safe compartment.
# we probably broke something, but do the best we can.
if ((ref $ex) =~ /^Devel::Confess::__ANON_/) {
- (undef, my $oldclass, $message) = @{$attached{$id}};
+ my $oldclass = $PACKAGES{$id};
+ $message = $MESSAGES{$id};
bless $ex, $oldclass;
}
else {
@@ -244,10 +291,11 @@
$message ||= _stack_trace();
- $attached{$id} = [ $ex, $class, $message ];
- weaken $attached{$id}[0];
+ weaken($EXCEPTIONS{$id} = $ex);
+ $PACKAGES{$id} = $class;
+ $MESSAGES{$id} = $message;
- my $newclass = __PACKAGE__ . '::__ANON_' . $pack_suffix++ . '__';
+ my $newclass = __PACKAGE__ . '::__ANON_' . $PACK_SUFFIX++ . '__';
{
no strict 'refs';
@@ -259,14 +307,14 @@
}
elsif (ref($ex = $_[0])) {
my $id = refaddr($ex);
- my $info = $attached{$id} ||= do {
- my $message = _stack_trace;
- my $info = [ $_[0], undef, $message ];
- weaken $info->[0];
- $info;
- };
- return ($^S ? @_ : ( @_, $info->[2] ));
+ my $message = _stack_trace;
+
+ weaken($EXCEPTIONS{$id} = $ex);
+ $PACKAGES{$id} = undef;
+ $MESSAGES{$id} ||= $message;
+
+ return ($^S ? @_ : ( @_, $message ));
}
elsif ((caller(1))[0] eq 'Carp') {
my $out = join('', @_);
@@ -281,22 +329,23 @@
}
else {
my $message = _stack_trace();
- $message =~ s/^(.*\n)//;
+ $message =~ s/^(.*\n?)//;
my $where = $1;
+ my $find = $where;
+ $find =~ s/(\.?\n?)\z//;
+ $find = qr/\Q$find\E(?: during global destruction)?(\.?\n?)/;
my $out = join('', @_);
- $out =~ s/\Q$where\E\z//;
+ $out =~ s/($find)\z//
+ and $where = $1;
return ($out, $where . $message);
}
}
-sub _ex_info {
- @{$attached{refaddr $_[0]}};
-}
-sub _delete_ex_info {
- @{ delete $attached{refaddr $_[0]} };
-}
sub _ex_as_strings {
- my ($ex, $class, $message) = _ex_info(@_);
+ my $ex = $_[0];
+ my $id = refaddr($ex);
+ my $class = $PACKAGES{$id};
+ my $message = $MESSAGES{$id};
my $newclass = ref $ex;
bless $ex, $class;
my $out = "$ex";
@@ -310,7 +359,8 @@
use overload
fallback => 1,
'bool' => sub {
- my ($ex, $class) = Devel::Confess::_ex_info(@_);
+ my $ex = $_[0];
+ my $class = $PACKAGES{Devel::Confess::refaddr($ex)};
my $newclass = ref $ex;
bless $ex, $class;
my $out = !!$ex;
@@ -318,7 +368,8 @@
return $out;
},
'0+' => sub {
- my ($ex, $class) = Devel::Confess::_ex_info(@_);
+ my $ex = $_[0];
+ my $class = $PACKAGES{Devel::Confess::refaddr($ex)};
my $newclass = ref $ex;
bless $ex, $class;
my $out = 0+sprintf '%f', $ex;
@@ -331,10 +382,31 @@
;
sub DESTROY {
- my ($ex, $class) = Devel::Confess::_delete_ex_info(@_);
+ my $ex = $_[0];
+ my $id = Devel::Confess::refaddr($ex);
+ my $class = delete $PACKAGES{$id} or return;
+ delete $MESSAGES{$id};
+ delete $EXCEPTIONS{$id};
+
my $newclass = ref $ex;
- Symbol::delete_package($newclass);
+ my $cloned;
+ # delete_package is more complete, but can explode on some perls
+ if (Devel::Confess::_BROKEN_CLONED_GLOB_UNDEF && delete
$Devel::Confess::CLONED{$id}) {
+ $cloned = 1;
+ no strict 'refs';
+ @{"${newclass}::ISA"} = ();
+ my $stash = \%{"${newclass}::"};
+ delete @{$stash}{keys %$stash};
+ }
+ else {
+ Symbol::delete_package($newclass);
+ }
+
+ if (Devel::Confess::_BROKEN_CLONED_DESTROY_REBLESS && $cloned || delete
$Devel::Confess::CLONED{$id}) {
+ my $destroy = $class->can('DESTROY') || return;
+ goto $destroy;
+ }
bless $ex, $class;
@@ -412,7 +484,7 @@
=head2 import( @options )
Enables stack traces and sets options. A list of options to enable can be
-passed in. Prefixing the options with no_ will disable them.
+passed in. Prefixing the options with C<no_> will disable them.
=over 4
@@ -544,11 +616,11 @@
=item *
-Graham Knop, E<lt>[email protected]<gt>
+Graham Knop <[email protected]>
=item *
-Adriano Ferreira, E<lt>[email protected]<gt>
+Adriano Ferreira <[email protected]>
=back
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/t/global-destruct.t
new/Devel-Confess-0.007011/t/global-destruct.t
--- old/Devel-Confess-0.007003/t/global-destruct.t 1970-01-01
01:00:00.000000000 +0100
+++ new/Devel-Confess-0.007011/t/global-destruct.t 2015-01-19
19:35:20.000000000 +0100
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+no warnings 'once';
+use Devel::Confess;
+use POSIX ();
+
+$| = 1;
+print "1..1\n";
+
+{
+ package MyException;
+ use overload
+ fallback => 1,
+ '""' => sub {
+ $_[0]->{message};
+ },
+ ;
+ sub new {
+ my ($class, $message) = @_;
+ my $self = bless { message => $message }, $class;
+ return $self;
+ }
+}
+
+sub foo {
+ eval { die MyException->new("yarp") };
+ $@;
+}
+
+sub bar {
+ foo();
+}
+
+
+# gd order is unpredictable, try multiple times
+our $last01 = bless {}, 'InGD';
+our $last02 = bless {}, 'InGD';
+our $ex = bar();
+our $stringy = "$ex";
+our $last03 = bless {}, 'InGD';
+our $last04 = bless {}, 'InGD';
+
+sub InGD::DESTROY {
+ if (!defined $ex) {
+ print "ok 1 # skip got unlucky on GD order, can't test\n";
+ }
+ else {
+ my $gd_stringy = "$ex";
+ my $ok = $gd_stringy eq $stringy;
+ print ( ($ok ? '' : 'not ') . "ok 1 - stringifies properly in global
destruction\n");
+ unless ($ok) {
+ s/^/# /mg, s/\n$//
+ for $stringy, $gd_stringy;
+ print "# Got:\n$gd_stringy\n#\n# Expected:\n$stringy\n";
+ POSIX::_exit(1);
+ }
+ }
+ POSIX::_exit(0);
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/t/leak.t
new/Devel-Confess-0.007011/t/leak.t
--- old/Devel-Confess-0.007003/t/leak.t 2014-07-26 22:27:56.000000000 +0200
+++ new/Devel-Confess-0.007011/t/leak.t 2015-01-24 18:54:54.000000000 +0100
@@ -2,7 +2,7 @@
use warnings;
use Scalar::Util;
use Test::More
- defined &Scalar::Util::weaken ? (tests => 3)
+ defined &Scalar::Util::weaken ? (tests => 4)
: (skip_all => "Can't prevent leaks without Scalar::Util::weaken");
use Devel::Confess;
@@ -31,3 +31,10 @@
ok !UNIVERSAL::can($class, 'DESTROY'), "temp packages don't leak";
+$gone = 0;
+eval {
+ MyException->throw;
+};
+Devel::Confess->CLONE;
+undef $@;
+is $gone, 1, "exception destroyed after \$@ cleared";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/t/lib/threads_check.pm
new/Devel-Confess-0.007011/t/lib/threads_check.pm
--- old/Devel-Confess-0.007003/t/lib/threads_check.pm 1970-01-01
01:00:00.000000000 +0100
+++ new/Devel-Confess-0.007011/t/lib/threads_check.pm 2015-01-26
04:21:29.000000000 +0100
@@ -0,0 +1,43 @@
+package t::lib::threads_check;
+
+sub _skip {
+ print "1..0 # SKIP $_[0]\n";
+ exit 0;
+}
+
+sub import {
+ my ($class, $op) = @_;
+ if ($0 eq '-' && $op) {
+ require POSIX;
+ if ($op eq 'installed') {
+ eval { require threads } or POSIX::_exit(1);
+ }
+ elsif ($op eq 'create') {
+ require threads;
+ require File::Spec;
+ open my $olderr, '>&', \*STDERR
+ or die "can't dup filehandle: $!";
+ open STDERR, '>', File::Spec->devnull
+ or die "can't open null: $!";
+ my $out = threads->create(sub { 1 })->join;
+ open STDERR, '>&', $olderr;
+ POSIX::_exit((defined $out && $out eq '1') ? 0 : 1);
+ }
+ else {
+ die "Invalid option $op!\n";
+ }
+ POSIX::_exit(0);
+ }
+ require Config;
+ if (! $Config::Config{useithreads}) {
+ _skip "your perl does not support ithreads";
+ }
+ elsif (system "$^X", '-Mt::lib::threads_check=installed') {
+ _skip "threads.pm not installed";
+ }
+ elsif (system "$^X", '-Mt::lib::threads_check=create') {
+ _skip "threads are broken on this machine";
+ }
+}
+
+1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/t/names.t
new/Devel-Confess-0.007011/t/names.t
--- old/Devel-Confess-0.007003/t/names.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Devel-Confess-0.007011/t/names.t 2015-01-28 21:01:49.000000000
+0100
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+use Devel::Confess ();
+use Test::More
+ Devel::Confess::_CAN_USE_INFORMATIVE_NAMES ? (tests => 2)
+ : (skip_all => "Can't enable better names at runtime on perl < 5.8");
+
+use Devel::Confess qw(better_names);
+
+sub foo {
+ die "welp";
+}
+
+my $bar = sub {
+ foo();
+};
+
+sub baz {
+ $bar->();
+}
+
+eval q{ baz; };
+my $err = $@;
+
+Devel::Confess->unimport;
+
+my $file = quotemeta __FILE__;
+
+my @lines = split /\n/, $err;
+
+like $lines[2], qr/main::__ANON__\[$file:\d+\]\(\) called at/,
+ 'anonymous function names include file and line number';
+
+like $lines[4], qr/baz;/,
+ 'string evals include eval text';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/t/sig.t
new/Devel-Confess-0.007011/t/sig.t
--- old/Devel-Confess-0.007003/t/sig.t 2014-07-16 07:46:11.000000000 +0200
+++ new/Devel-Confess-0.007011/t/sig.t 2015-01-28 17:31:56.000000000 +0100
@@ -1,12 +1,21 @@
use strict;
use warnings;
-use Test::More tests => 10;
-my $tm_die; BEGIN { $tm_die = $SIG{__DIE__} }
+use Test::More tests => 12;
use t::lib::capture;
+# preload to make sure we only test the effect of our own import
+use base ();
+use Exporter ();
+use Carp ();
+use Carp::Heavy ();
+use Symbol ();
+
+my $pre_die;
+BEGIN { $pre_die = $SIG{__DIE__} }
+
use Devel::Confess ();
-is $SIG{__DIE__}, $tm_die, 'not activated without import';
+is $SIG{__DIE__}, $pre_die, 'not activated without import';
my $called;
sub CALLED { $called++ };
$SIG{__DIE__} = \&CALLED;
@@ -18,6 +27,11 @@
Devel::Confess->unimport;
is $SIG{__DIE__}, \&CALLED, 'unimport restores __DIE__ handler';
+$SIG{__DIE__} = '';
+Devel::Confess->import;
+Devel::Confess->unimport;
+ok !$SIG{__DIE__}, 'unimport restores nonexistent __DIE__ handler';
+
sub IGNORE { $called++ }
sub DEFAULT { $called++ }
sub other::sub { $called++ }
@@ -95,3 +109,28 @@
#line 3 test-block.pl
A::g();
END_CODE
+
+is capture <<'END_CODE', <<'END_OUTPUT', 'outer __WARN__ gets full location';
+BEGIN { $SIG{__WARN__} = sub { warn $_[0] } }
+use Devel::Confess;
+package A;
+
+sub f {
+#line 1 test-block.pl
+ warn "Beware!";
+}
+
+sub g {
+#line 2 test-block.pl
+ f();
+}
+
+package main;
+
+#line 3 test-block.pl
+A::g();
+END_CODE
+Beware! at test-block.pl line 1.
+ A::f() called at test-block.pl line 2
+ A::g() called at test-block.pl line 3
+END_OUTPUT
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Devel-Confess-0.007003/t/threads.t
new/Devel-Confess-0.007011/t/threads.t
--- old/Devel-Confess-0.007003/t/threads.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Devel-Confess-0.007011/t/threads.t 2015-01-26 04:20:41.000000000
+0100
@@ -0,0 +1,62 @@
+use t::lib::threads_check;
+use threads;
+use strict;
+use warnings;
+use Test::More tests => 3;
+use Devel::Confess;
+
+my $gone = 0;
+{
+ package MyException;
+ use overload
+ fallback => 1,
+ '""' => sub {
+ $_[0]->{message};
+ },
+ ;
+ sub new {
+ my ($class, $message) = @_;
+ my $self = bless { message => $message }, $class;
+ return $self;
+ }
+ sub DESTROY {
+ $gone++;
+ }
+}
+
+sub foo {
+ eval { die MyException->new("yarp") };
+ $@;
+}
+
+sub bar {
+ foo();
+}
+
+my $ex = bar();
+
+my $stringy_ex = "$ex";
+
+my $stringy_from_thread = threads->create(sub {
+ "$ex";
+})->join;
+
+is $stringy_from_thread, $stringy_ex,
+ 'stack trace maintained across threads';
+
+my $thread_gone = threads->create(sub {
+ undef $ex;
+ $gone;
+})->join;
+
+is $thread_gone, $gone + 1,
+ 'DESTROY called in threads for cloned exception';
+
+my $cleared = threads->create(sub {
+ my $class = ref $ex;
+ undef $ex;
+ UNIVERSAL::can($class, 'DESTROY') ? 0 : 1;
+})->join;
+
+ok $cleared,
+ 'cloned exception cleans up namespace when destroyed';
--
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
