diff options
author | Norbert Preining <norbert@preining.info> | 2021-04-02 03:20:54 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2021-04-02 03:20:54 +0000 |
commit | 3f173002d4a4a84e7d1fa5a74755fdd00d08a9c2 (patch) | |
tree | 5ed380344702de1f9ab53b68b6c3bcd6b8458087 /systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm | |
parent | f78ba658b3ecd56053fe0837a4404d0c6c16a707 (diff) |
CTAN sync 202104020320
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm index 16e1743474..09abfb8536 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Fatal.pm @@ -8,7 +8,7 @@ use strict; use warnings; use Tie::RefHash; # To cache subroutine refs use Config; -use Scalar::Util qw(set_prototype); +use Scalar::Util qw(set_prototype looks_like_number); use autodie::Util qw( fill_protos @@ -55,7 +55,7 @@ use constant ERROR_58_HINTS => q{Non-subroutine %s hints for %s are not supporte use constant MIN_IPC_SYS_SIMPLE_VER => 0.12; -our $VERSION = '2.29'; # VERSION: Generated by DZP::OurPkg::Version +our $VERSION = '2.32'; # VERSION: Generated by DZP::OurPkg::Version our $Debug ||= 0; @@ -165,6 +165,9 @@ my %TAGS = ( ':2.27' => [qw(:default)], ':2.28' => [qw(:default)], ':2.29' => [qw(:default)], + ':2.30' => [qw(:default)], + ':2.31' => [qw(:default)], + ':2.32' => [qw(:default)], ); @@ -580,7 +583,12 @@ sub unimport { # Record the current sub to be reinstalled at end of scope # and then restore the original (can be undef for "CORE::" # subs) - $reinstall_subs{$symbol} = \&$sub; + + { + no strict 'refs'; ## no critic # to avoid: Can't use string (...) as a symbol ref ... + $reinstall_subs{$symbol} = \&$sub + if exists ${"${pkg}::"}{$symbol}; + } $uninstall_subs{$symbol} = $Original_user_sub{$sub}; } @@ -1023,6 +1031,26 @@ sub _one_invocation { }; } + if ($call eq 'CORE::kill') { + + return qq[ + + my \$num_things = \@_ - $Returns_num_things_changed{$call}; + my \$context = ! defined wantarray() ? 'void' : 'scalar'; + my \$signal = \$_[0]; + my \$retval = $call(@argv); + my \$sigzero = looks_like_number( \$signal ) && \$signal == 0; + + if ( ( \$sigzero && \$context eq 'void' ) + or ( ! \$sigzero && \$retval != \$num_things ) ) { + + $die; + } + + return \$retval; + ]; + } + if (exists $Returns_num_things_changed{$call}) { # Some things return the number of things changed (like |