Hello community, here is the log from the commit of package perl-autodie for openSUSE:Factory checked in at 2013-10-06 14:53:00 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-autodie (Old) and /work/SRC/openSUSE:Factory/.perl-autodie.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-autodie" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-autodie/perl-autodie.changes 2013-07-30 16:37:02.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-autodie.new/perl-autodie.changes 2013-10-06 14:53:01.000000000 +0200 @@ -1,0 +2,41 @@ +Fri Oct 4 09:15:25 UTC 2013 - [email protected] + +- updated to 2.22 + * TEST / INTERNAL: Restore timestamps on touched testing + files to avoid git flagging files having changed in + git. (RT #88444, courtesy shay@cpan) + + Many more improvements from Niels Thykier, great hero of the + free people. Plus a compatibility patch from Zefram, keeper + of Carp. + + * SPEED / INTERNAL : Through the magic of globally reuseable + core leak trampolines, autodie is even faster when used across + multiple pacakages. + + * SPEED / INTERNAL : Caches used for keeping track of + fatalised subroutines are faster and leaner. + + * SPEED / INTERNAL : Core subroutine wrappers are now lazily + compiled. + + * SPEED / INTERNAL : Using autodie while autodie is already in + effect is now faster and more efficient. + + * INTERNAL : $" and $! are no longer arbitrarily messed with + for no reason via autodie. (They're still messed with when + using Fatal.) + + * SPEED / INTERNAL : The ':all' tag hierachy is expanded + immediately, in an efficient fashion. + + * INTERNAL : Numerous minor clean-ups. Dead variables removed. + Typos fixed. + + * SPEED / INTERNAL : import() and _make_fatal() cache more + aggressively, reducing CPU overhead. + + * TEST: Compatibility with Carp 1.32 (thanks to Zefram). + RT #88076. + +------------------------------------------------------------------- Old: ---- autodie-2.20.tar.gz New: ---- autodie-2.22.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-autodie.spec ++++++ --- /var/tmp/diff_new_pack.0MijBi/_old 2013-10-06 14:53:02.000000000 +0200 +++ /var/tmp/diff_new_pack.0MijBi/_new 2013-10-06 14:53:02.000000000 +0200 @@ -17,7 +17,7 @@ Name: perl-autodie -Version: 2.20 +Version: 2.22 Release: 0 %define cpan_name autodie Summary: Replace functions with ones that succeed or die with lexical scope ++++++ autodie-2.20.tar.gz -> autodie-2.22.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/Changes new/autodie-2.22/Changes --- old/autodie-2.20/Changes 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/Changes 2013-09-21 04:37:23.000000000 +0200 @@ -1,5 +1,46 @@ Revision history for autodie +2.22 2013-09-21 11:37:14 Asia/Tokyo + + * TEST / INTERNAL: Restore timestamps on touched testing + files to avoid git flagging files having changed in + git. (RT #88444, courtesy shay@cpan) + +2.21 2013-09-12 13:17:23 Australia/Melbourne + + Many more improvements from Niels Thykier, great hero of the + free people. Plus a compatibility patch from Zefram, keeper + of Carp. + + * SPEED / INTERNAL : Through the magic of globally reuseable + core leak trampolines, autodie is even faster when used across + multiple pacakages. + + * SPEED / INTERNAL : Caches used for keeping track of + fatalised subroutines are faster and leaner. + + * SPEED / INTERNAL : Core subroutine wrappers are now lazily + compiled. + + * SPEED / INTERNAL : Using autodie while autodie is already in + effect is now faster and more efficient. + + * INTERNAL : $" and $! are no longer arbitrarily messed with + for no reason via autodie. (They're still messed with when + using Fatal.) + + * SPEED / INTERNAL : The ':all' tag hierachy is expanded + immediately, in an efficient fashion. + + * INTERNAL : Numerous minor clean-ups. Dead variables removed. + Typos fixed. + + * SPEED / INTERNAL : import() and _make_fatal() cache more + aggressively, reducing CPU overhead. + + * TEST: Compatibility with Carp 1.32 (thanks to Zefram). + RT #88076. + 2.20 2013-06-23 16:08:41 PST8PDT Many improvements from Niels Thykier, hero of the diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/META.json new/autodie-2.22/META.json --- old/autodie-2.20/META.json 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/META.json 2013-09-21 04:37:23.000000000 +0200 @@ -80,6 +80,6 @@ "web" : "https://github.com/pjf/autodie"; } }, - "version" : "2.20" + "version" : "2.22" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/META.yml new/autodie-2.22/META.yml --- old/autodie-2.20/META.yml 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/META.yml 2013-09-21 04:37:23.000000000 +0200 @@ -43,4 +43,4 @@ resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie repository: git://github.com/pjf/autodie -version: 2.20 +version: 2.22 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/Makefile.PL new/autodie-2.22/Makefile.PL --- old/autodie-2.20/Makefile.PL 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/Makefile.PL 2013-09-21 04:37:23.000000000 +0200 @@ -45,7 +45,7 @@ "Test::More" => 0, "open" => 0 }, - "VERSION" => "2.20", + "VERSION" => "2.22", "test" => { "TESTS" => "t/*.t" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/lib/Fatal.pm new/autodie-2.22/lib/Fatal.pm --- old/autodie-2.20/lib/Fatal.pm 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/lib/Fatal.pm 2013-09-21 04:37:23.000000000 +0200 @@ -16,6 +16,12 @@ use constant VOID_TAG => q{:void}; use constant INSIST_TAG => q{!}; +# Keys for %Cached_fatalised_sub (used in 3rd level) +use constant CACHE_AUTODIE_LEAK_GUARD => 0; +use constant CACHE_FATAL_WRAPPER => 1; +use constant CACHE_FATAL_VOID => 2; + + use constant ERROR_NOARGS => 'Cannot use lexical %s with no arguments'; use constant ERROR_VOID_LEX => VOID_TAG.' cannot be used with lexical scope'; use constant ERROR_LEX_FIRST => LEXICAL_TAG.' must be used as first argument'; @@ -42,7 +48,7 @@ use constant MIN_IPC_SYS_SIMPLE_VER => 0.12; -our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg::Version +our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg::Version our $Debug ||= 0; @@ -136,12 +142,27 @@ ':2.18' => [qw(:default)], ':2.19' => [qw(:default)], ':2.20' => [qw(:default)], + ':2.21' => [qw(:default)], + ':2.22' => [qw(:default)], ); # chmod was only introduced in 2.07 # chown was only introduced in 2.14 -$TAGS{':all'} = [ keys %TAGS ]; +{ + # Expand :all immediately by expanding and flattening all tags. + # _expand_tag is not really optimised for expanding the ":all" + # case (i.e. keys %TAGS, or values %TAGS for that matter), so we + # just do it here. + # + # NB: The %tag_cache/_expand_tag relies on $TAGS{':all'} being + # pre-expanded. + my %seen; + my @all = grep { + !/^:/ && !$seen{$_}++ + } map { @{$_} } values %TAGS; + $TAGS{':all'} = \@all; +} # This hash contains subroutines for which we should # subroutine() // die() rather than subroutine() || die() @@ -295,6 +316,10 @@ my %Trampoline_cache; +# A cache mapping "CORE::<name>" to their prototype. Turns out that if +# you "use autodie;" enough times, this pays off. +my %CORE_prototype_cache; + # We use our package in a few hash-keys. Having it in a scalar is # convenient. The "guard $PACKAGE" string is used as a key when # setting up lexical guards. @@ -344,8 +369,10 @@ my @fatalise_these = @_; - # Thiese subs will get unloaded at the end of lexical scope. + # These subs will get unloaded at the end of lexical scope. my %unload_later; + # These subs are to be installed into callers namespace. + my %install_subs; # Use _translate_import_args to expand tags for us. It will # pass-through unknown tags (i.e. we have to manually handle @@ -377,9 +404,10 @@ # Check to see if there's an insist flag at the front. # If so, remove it, and insist we have hints for this sub. - my $insist_this; + my $insist_this = $insist_hints; - if ($func =~ s/^!//) { + if (substr($func, 0, 1) eq '!') { + $func = substr($func, 1); $insist_this = 1; } @@ -408,7 +436,7 @@ my $sub_ref = $class->_make_fatal( $func, $pkg, $void, $lexical, $filename, - ( $insist_this || $insist_hints ) + $insist_this, \%install_subs, ); $Original_user_sub{$sub} ||= $sub_ref; @@ -421,6 +449,8 @@ } } + $class->_install_subs($pkg, \%install_subs); + if ($lexical) { # Dark magic to have autodie work under 5.8 @@ -525,6 +555,7 @@ # in which case, we disable Fatalistic behaviour for 'blah'. my @unimport_these = @_ ? @_ : ':all'; + my %uninstall_subs; for my $symbol ($class->_translate_import_args(@unimport_these)) { @@ -546,17 +577,19 @@ if (my $original_sub = $Original_user_sub{$sub}) { # Hey, we've got an original one of these, put it back. - $class->_install_subs($pkg, { $symbol => $original_sub }); + $uninstall_subs{$symbol} = $original_sub; next; } # We don't have an original copy of the sub, on the assumption # it's core (or doesn't exist), we'll just nuke it. - $class->_install_subs($pkg,{ $symbol => undef }); + $uninstall_subs{$symbol} = undef; } + $class->_install_subs($pkg, \%uninstall_subs); + return; } @@ -596,7 +629,11 @@ # continuing to work. { - my %tag_cache; + # We assume that $TAGS{':all'} is pre-expanded and just fill it in + # from the beginning. + my %tag_cache = ( + 'all' => [map { "CORE::$_" } @{$TAGS{':all'}}], + ); # Expand a given tag (e.g. ":default") into a listref containing # all sub names covered by that tag. Each sub is returned as @@ -636,10 +673,6 @@ # at the price of being a bit more verbose/low-level. if (substr($item, 0, 1) eq ':') { # Use recursion here to ensure we expand a tag at most once. - # - # TODO: Improve handling of :all so we don't expand - # all those aliases (e.g :2.00..:2.07 are all aliases - # of v2.07). my $expanded = $class->_expand_tag($item); push @taglist, grep { !$seen{$_}++ } @{$expanded}; @@ -1105,11 +1138,21 @@ # TODO - BACKCOMPAT - This is not yet compatible with 5.10.0 sub _make_fatal { - my($class, $sub, $pkg, $void, $lexical, $filename, $insist) = @_; - my($name, $code, $sref, $real_proto, $proto, $core, $call, $hints); + my($class, $sub, $pkg, $void, $lexical, $filename, $insist, $install_subs) = @_; + my($code, $sref, $real_proto, $proto, $core, $call, $hints, $cache, $cache_type); my $ini = $sub; + my $name = $sub; + + + if (index($sub, '::') == -1) { + $sub = "${pkg}::$sub"; + if (substr($name, 0, 1) eq '&') { + $name = substr($name, 1); + } + } else { + $name =~ s/.*:://; + } - $sub = "${pkg}::$sub" unless $sub =~ /::/; # Figure if we're using lexical or package semantics and # twiddle the appropriate bits. @@ -1121,8 +1164,6 @@ # TODO - We *should* be able to do skipping, since we know when # we've lexicalised / unlexicalised a subroutine. - $name = $sub; - $name =~ s/.*::// or $name =~ s/^&//; warn "# _make_fatal: sub=$sub pkg=$pkg name=$name void=$void\n" if $Debug; croak(sprintf(ERROR_BADNAME, $class, $name)) unless $name =~ /^\w+$/; @@ -1137,7 +1178,7 @@ # This could be something that we've fatalised that # was in core. - if ( $Package_Fatal{$sub} and do { local $@; eval { prototype "CORE::$name" } } ) { + if ( $Package_Fatal{$sub} and exists($CORE_prototype_cache{"CORE::$name"})) { # Something we previously made Fatal that was core. # This is safe to replace with an autodying to core @@ -1145,7 +1186,7 @@ $core = 1; $call = "CORE::$name"; - $proto = prototype $call; + $proto = $CORE_prototype_cache{$call}; # We return our $sref from this subroutine later # on, indicating this subroutine should be placed @@ -1159,29 +1200,51 @@ # then look-up the name of the original sub for the rest of # our processing. - $sub = $Is_fatalised_sub{\&$sub} || $sub; + if (exists($Is_fatalised_sub{\&$sub})) { + # $sub is one of our wrappers around a CORE sub or a + # user sub. Instead of wrapping our wrapper, lets just + # generate a new wrapper for the original sub. + # - NB: the current wrapper might be for a different class + # than the one we are generating now (e.g. some limited + # mixing between use Fatal + use autodie can occur). + # - Even for nested autodie, we need this as the leak guards + # differ. + my $s = $Is_fatalised_sub{\&$sub}; + if (defined($s)) { + # It is a wrapper for a user sub + $sub = $s; + } else { + # It is a wrapper for a CORE:: sub + $core = 1; + $call = "CORE::$name"; + $proto = $CORE_prototype_cache{$call}; + } + } # A regular user sub, or a user sub wrapping a # core sub. $sref = \&$sub; - $proto = prototype $sref; - $call = '&$sref'; - require autodie::hints; + if (!$core) { + # A non-CORE sub might have hints and such... + $proto = prototype($sref); + $call = '&$sref'; + require autodie::hints; - $hints = autodie::hints->get_hints_for( $sref ); + $hints = autodie::hints->get_hints_for( $sref ); - # If we've insisted on hints, but don't have them, then - # bail out! + # If we've insisted on hints, but don't have them, then + # bail out! - if ($insist and not $hints) { - croak(sprintf(ERROR_NOHINTS, $name)); - } + if ($insist and not $hints) { + croak(sprintf(ERROR_NOHINTS, $name)); + } - # Otherwise, use the default hints if we don't have - # any. + # Otherwise, use the default hints if we don't have + # any. - $hints ||= autodie::hints::DEFAULT_HINTS(); + $hints ||= autodie::hints::DEFAULT_HINTS(); + } } @@ -1221,7 +1284,6 @@ } $call = 'CORE::system'; - $name = 'system'; $core = 1; } elsif ($name eq 'exec') { @@ -1230,24 +1292,26 @@ # the regular form a "do or die" behavior as expected. $call = 'CORE::exec'; - $name = 'exec'; $core = 1; } else { # CORE subroutine - my $E; - { - local $@; - $proto = eval { prototype "CORE::$name" }; - $E = $@; + $call = "CORE::$name"; + if (exists($CORE_prototype_cache{$call})) { + $proto = $CORE_prototype_cache{$call}; + } else { + my $E; + { + local $@; + $proto = eval { prototype $call }; + $E = $@; + } + croak(sprintf(ERROR_NOT_BUILT,$name)) if $E; + croak(sprintf(ERROR_CANT_OVERRIDE,$name)) if not defined $proto; + $CORE_prototype_cache{$call} = $proto; } - croak(sprintf(ERROR_NOT_BUILT,$name)) if $E; - croak(sprintf(ERROR_CANT_OVERRIDE,$name)) if not defined $proto; $core = 1; - $call = "CORE::$name"; } - my $true_name = $core ? $call : $sub; - # TODO: This caching works, but I don't like using $void and # $lexical as keys. In particular, I suspect our code may end up # wrapping already wrapped code when autodie and Fatal are used @@ -1258,8 +1322,16 @@ # results code that's in the wrong package, and hence has # access to the wrong package filehandles. - if (my $subref = $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical}) { - $class->_install_subs($pkg, { $name => $subref }); + $cache = $Cached_fatalised_sub{$class}{$sub}; + if ($lexical) { + $cache_type = CACHE_AUTODIE_LEAK_GUARD; + } else { + $cache_type = CACHE_FATAL_WRAPPER; + $cache_type = CACHE_FATAL_VOID if $void; + } + + if (my $subref = $cache->{$cache_type}) { + $install_subs->{$name} = $subref; return $sref; } @@ -1272,67 +1344,21 @@ # - for lexical variants, we need a leak guard as well. $code = $reusable_builtins{$call}{$lexical}; if (!$lexical && defined($code)) { - $class->_install_subs($pkg, { $name => $code }); + $install_subs->{$name} = $code; return $sref; } } - if (defined $proto) { - $real_proto = " ($proto)"; - } else { - $real_proto = ''; - $proto = '@'; - } - - if (!defined($code)) { + if (!($lexical && $core) && !defined($code)) { # No code available, generate it now. - my @protos = fill_protos($proto); - - $code = qq[ - sub$real_proto { - local(\$", \$!) = (', ', 0); # TODO - Why do we do this? - ]; - - # Don't have perl whine if exec fails, since we'll be handling - # the exception now. - $code .= "no warnings qw(exec);\n" if $call eq "CORE::exec"; - - $code .= $class->_write_invocation($core, $call, $name, $void, $lexical, - $sub, $sref, @protos); - $code .= "}\n"; - warn $code if $Debug; - - # I thought that changing package was a monumental waste of - # time for CORE subs, since they'll always be the same. However - # that's not the case, since they may refer to package-based - # filehandles (eg, with open). - # - # The %reusable_builtins hash defines ones we can aggressively - # cache as they never depend upon package-based symbols. - - { - no strict 'refs'; ## no critic # to avoid: Can't use string (...) as a symbol ref ... - - my $E; - - { - local $@; - if (!exists($reusable_builtins{$call})) { - $code = eval("package $pkg; require Carp; $code"); ## no critic - } else { - $code = eval("require Carp; $code"); ## no critic - if (exists $reusable_builtins{$call}) { - # cache it so we don't recompile this part again - $reusable_builtins{$call}{$lexical} = $code; - } - } - $E = $@; - } - - if (not $code) { - croak("Internal error in autodie/Fatal processing $true_name: $E"); - - } + my $wrapper_pkg = $pkg; + $wrapper_pkg = undef if (exists($reusable_builtins{$call})); + $code = $class->_compile_wrapper($wrapper_pkg, $core, $call, $name, + $void, $lexical, $sub, $sref, + $hints, $proto); + if (!defined($wrapper_pkg)) { + # cache it so we don't recompile this part again + $reusable_builtins{$call}{$lexical} = $code; } } @@ -1347,18 +1373,22 @@ # TODO: This is pretty hairy code. A lot more tests would # be really nice for this. - my $leak_guard; + my $installed_sub = $code; if ($lexical) { - $leak_guard = _make_leak_guard($filename, $code, $sref, $call, - $pkg, $proto, $real_proto); + my $real_proto = ''; + if (defined $proto) { + $real_proto = " ($proto)"; + } else { + $proto = '@'; + } + $installed_sub = $class->_make_leak_guard($filename, $code, $sref, $call, + $pkg, $proto, $real_proto); } - my $installed_sub = $leak_guard || $code; - - $class->_install_subs($pkg, { $name => $installed_sub }); + $cache->{$cache_type} = $code; - $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical} = $installed_sub; + $install_subs->{$name} = $installed_sub; # Cache that we've now overridden this sub. If we get called # again, we may need to find that find subroutine again (eg, for hints). @@ -1421,7 +1451,7 @@ # Creates and returns a leak guard (with prototype if needed). sub _make_leak_guard { - my ($filename, $wrapped_sub, $orig_sub, $call, $pkg, $proto, $real_proto) = @_; + my ($class, $filename, $wrapped_sub, $orig_sub, $call, $pkg, $proto, $real_proto) = @_; # The leak guard is rather lengthly (in fact it makes up the most # of _make_leak_guard). It is possible to split it into a large @@ -1449,34 +1479,97 @@ if ($caller eq $filename) { # No leak, call the wrapper. NB: In this case, it doesn't # matter if it is a CORE sub or not. + if (!defined($wrapped_sub)) { + # CORE sub that we were too lazy to compile when we + # created this leak guard. + die "$call is not CORE::<something>" + if substr($call, 0, 6) ne 'CORE::'; + + my $name = substr($call, 6); + my $sub = $name; + my $lexical = 1; + my $wrapper_pkg = $pkg; + my $code; + if (exists($reusable_builtins{$call})) { + $code = $reusable_builtins{$call}{$lexical}; + $wrapper_pkg = undef; + } + if (!defined($code)) { + $code = $class->_compile_wrapper($wrapper_pkg, + 1, # core + $call, + $name, + 0, # void + $lexical, + $sub, + undef, # subref (not used for core) + undef, # hints (not used for core) + $proto); + + if (!defined($wrapper_pkg)) { + # cache it so we don't recompile this part again + $reusable_builtins{$call}{$lexical} = $code; + } + } + # As $wrapped_sub is "closed over", updating its value will + # be "remembered" for the next call. + $wrapped_sub = $code; + } goto $wrapped_sub; } # We leaked, time to call the original function. # - for non-core functions that will be $orig_sub + # - for CORE functions, $orig_sub may be a trampoline goto $orig_sub if defined($orig_sub); - # We are wrapping a CORE sub + # We are wrapping a CORE sub and we do not have a trampoline + # yet. + # + # If we've cached a trampoline, then use it. Usually only + # resuable subs will have cache hits, but non-reusuably ones + # can get it as well in (very) rare cases. It is mostly in + # cases where a package uses autodie multiple times and leaks + # from multiple places. Possibly something like: + # + # package Pkg::With::LeakyCode; + # sub a { + # use autodie; + # code_that_leaks(); + # } + # + # sub b { + # use autodie; + # more_leaky_code(); + # } + # + # Note that we use "Fatal" as package name for reusable subs + # because A) that allows us to trivially re-use the + # trampolines as well and B) because the reusable sub is + # compiled into "package Fatal" as well. - # If we've cached a trampoline, then use it. - my $trampoline_sub = $Trampoline_cache{$pkg}{$call}; + $pkg = 'Fatal' if exists $reusable_builtins{$call}; + $orig_sub = $Trampoline_cache{$pkg}{$call}; - if (not $trampoline_sub) { + if (not $orig_sub) { # If we don't have a trampoline, we need to build it. # # We only generate trampolines when we need them, and # we can cache them by subroutine + package. + # + # As $orig_sub is "closed over", updating its value will + # be "remembered" for the next call. - # TODO: Consider caching on reusable_builtins status as well. - - $trampoline_sub = _make_core_trampoline($call, $pkg, $proto); + $orig_sub = _make_core_trampoline($call, $pkg, $proto); - # Let's cache that, so we don't have to do it again. - $Trampoline_cache{$pkg}{$call} = $trampoline_sub; + # We still cache it despite remembering it in $orig_sub as + # well. In particularly, we rely on this to avoid + # re-compiling the reusable trampolines. + $Trampoline_cache{$pkg}{$call} = $orig_sub; } # Bounce to our trampoline, which takes us to our core sub. - goto \&$trampoline_sub; + goto $orig_sub; }; # <-- end of leak guard # If there is a prototype on the original sub, copy it to the leak @@ -1535,6 +1628,66 @@ return $trampoline_sub; } +sub _compile_wrapper { + my ($class, $wrapper_pkg, $core, $call, $name, $void, $lexical, $sub, $sref, $hints, $proto) = @_; + my $real_proto = ''; + my @protos; + my $code; + if (defined $proto) { + $real_proto = " ($proto)"; + } else { + $proto = '@'; + } + + @protos = fill_protos($proto); + $code = qq[ + sub$real_proto { + ]; + + if (!$lexical) { + $code .= q[ + local($", $!) = (', ', 0); + ]; + } + + # Don't have perl whine if exec fails, since we'll be handling + # the exception now. + $code .= "no warnings qw(exec);\n" if $call eq "CORE::exec"; + + $code .= $class->_write_invocation($core, $call, $name, $void, $lexical, + $sub, $sref, @protos); + $code .= "}\n"; + warn $code if $Debug; + + # I thought that changing package was a monumental waste of + # time for CORE subs, since they'll always be the same. However + # that's not the case, since they may refer to package-based + # filehandles (eg, with open). + # + # The %reusable_builtins hash defines ones we can aggressively + # cache as they never depend upon package-based symbols. + + my $E; + + { + no strict 'refs'; ## no critic # to avoid: Can't use string (...) as a symbol ref ... + local $@; + if (defined($wrapper_pkg)) { + $code = eval("package $wrapper_pkg; require Carp; $code"); ## no critic + } else { + $code = eval("require Carp; $code"); ## no critic + + } + $E = $@; + } + + if (not $code) { + my $true_name = $core ? $call : $sub; + croak("Internal error in autodie/Fatal processing $true_name: $E"); + } + return $code; +} + # For some reason, dying while replacing our subs doesn't # kill our calling program. It simply stops the loading of # autodie and keeps going with everything else. The _autocroak diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/lib/autodie/exception/system.pm new/autodie-2.22/lib/autodie/exception/system.pm --- old/autodie-2.20/lib/autodie/exception/system.pm 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/lib/autodie/exception/system.pm 2013-09-21 04:37:23.000000000 +0200 @@ -5,7 +5,7 @@ use base 'autodie::exception'; use Carp qw(croak); -our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg:Version +our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg:Version # ABSTRACT: Exceptions from autodying system(). diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/lib/autodie/exception.pm new/autodie-2.22/lib/autodie/exception.pm --- old/autodie-2.20/lib/autodie/exception.pm 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/lib/autodie/exception.pm 2013-09-21 04:37:23.000000000 +0200 @@ -4,7 +4,7 @@ use warnings; use Carp qw(croak); -our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg:Version +our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg:Version # ABSTRACT: Exceptions from autodying functions. our $DEBUG = 0; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/lib/autodie/hints.pm new/autodie-2.22/lib/autodie/hints.pm --- old/autodie-2.20/lib/autodie/hints.pm 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/lib/autodie/hints.pm 2013-09-21 04:37:23.000000000 +0200 @@ -5,7 +5,7 @@ use constant PERL58 => ( $] < 5.009 ); -our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg:Version +our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg:Version # ABSTRACT: Provide hints about user subroutines to autodie diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/lib/autodie/skip.pm new/autodie-2.22/lib/autodie/skip.pm --- old/autodie-2.20/lib/autodie/skip.pm 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/lib/autodie/skip.pm 2013-09-21 04:37:23.000000000 +0200 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = '2.20'; # VERSION +our $VERSION = '2.22'; # VERSION # This package exists purely so people can inherit from it, # which isn't at all how roles are supposed to work, but it's diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/lib/autodie.pm new/autodie-2.22/lib/autodie.pm --- old/autodie-2.20/lib/autodie.pm 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/lib/autodie.pm 2013-09-21 04:37:23.000000000 +0200 @@ -10,7 +10,7 @@ # ABSTRACT: Replace functions with ones that succeed or die with lexical scope BEGIN { - our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg::Version + our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg::Version } use constant ERROR_WRONG_FATAL => q{ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/t/backcompat.t new/autodie-2.22/t/backcompat.t --- old/autodie-2.20/t/backcompat.t 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/t/backcompat.t 2013-09-21 04:37:23.000000000 +0200 @@ -8,7 +8,7 @@ open(my $fh, '<', NO_SUCH_FILE); }; -my $old_msg = qr{Can't open\(GLOB\(0x[0-9a-f]+\), <, xyzzy_this_file_is_not_here\): .* at \(eval \d+\)(?:\[.*?\])? line \d+\.?\s+main::__ANON__\('GLOB\(0x[0-9a-f]+\)',\s*'<',\s*'xyzzy_this_file_is_not_here'\) called at \S+ line \d+\s+eval \Q{...}\E called at \S+ line \d+}; +my $old_msg = qr{Can't open\(GLOB\(0x[0-9a-f]+\), <, xyzzy_this_file_is_not_here\): .* at \(eval \d+\)(?:\[.*?\])? line \d+\.?\s+main::__ANON__\('?GLOB\(0x[0-9a-f]+\)'?,\s*['"]<['"],\s*['"]xyzzy_this_file_is_not_here['"]\) called at \S+ line \d+\s+eval \Q{...}\E called at \S+ line \d+}; like($@,$old_msg,"Backwards compat ugly messages"); is(ref($@),"", "Exception is a string, not an object"); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/autodie-2.20/t/utime.t new/autodie-2.22/t/utime.t --- old/autodie-2.20/t/utime.t 2013-06-24 01:08:50.000000000 +0200 +++ new/autodie-2.22/t/utime.t 2013-09-21 04:37:23.000000000 +0200 @@ -10,9 +10,15 @@ eval { utime(undef, undef, NO_SUCH_FILE); }; isa_ok($@, 'autodie::exception', 'exception thrown for utime'); +my($atime, $mtime) = (stat TOUCH_ME)[8, 9]; + eval { utime(undef, undef, TOUCH_ME); }; ok(! $@, "We can utime a file just fine.") or diag $@; eval { utime(undef, undef, NO_SUCH_FILE, TOUCH_ME); }; isa_ok($@, 'autodie::exception', 'utime exception on single failure.'); is($@->return, 1, "utime fails correctly on a 'true' failure."); + +# Reset timestamps so that Git doesn't think the file has changed when +# running the test in the core perl distribution. +utime($atime, $mtime, TOUCH_ME); -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
