In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/5d70f8f9a94124c9e77138d92611f5765f8793ad?hp=b43c8b6097ab8a06b5e3f161de81ecdc3b88cffa>
- Log ----------------------------------------------------------------- commit 5d70f8f9a94124c9e77138d92611f5765f8793ad Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Mar 11 15:28:27 2018 -0700 Carp: Use ${^LAST_FH} if available Using ${^LAST_FH}, available in 5.18, in faster than using eval/die to get the last file handle. Also, the eval/die method is not going to produce anything if $. is 0 so skip that entire block if $. is false (by removing the defined check). (Not significant enough for perldelta. carp("zonk") gets faster by only 5% or so.) commit f8b8ba603b2ee25a74c91b3f9e292db14b2f4ab6 Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Mar 11 14:25:14 2018 -0700 Let cmp_version be run from the top level I’m used to typing ‘./perl -Ilib t/porting/cmp_version.t’; it’s annoy- ing to have to add ‘-I.’. (Obviously no perldelta entry necessary.) commit 06afc688394f2ee3027d9ab81e7fa58256a91645 Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Mar 11 14:23:42 2018 -0700 warnings.pm: sprintf is faster than concat I benchmarked this line alone in a one-liner and found the sprintf variant to be roughly 10% faster than the concat version. It’s also more readable (and maintainable). (Not significant enough to warrant a perldelta entry.) ----------------------------------------------------------------------- Summary of changes: dist/Carp/lib/Carp.pm | 21 ++++++++++++++++++++- lib/warnings.pm | 5 +++-- regen/warnings.pl | 5 +++-- t/porting/cmp_version.t | 1 + 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm index 25ba942ad1..97f6604a17 100644 --- a/dist/Carp/lib/Carp.pm +++ b/dist/Carp/lib/Carp.pm @@ -571,6 +571,15 @@ sub longmess_heavy { return ret_backtrace( $i, @_ ); } +BEGIN { + if("$]" >= 5.017004) { + # The LAST_FH constant is a reference to the variable. + $Carp::{LAST_FH} = \eval '\${^LAST_FH}'; + } else { + eval '*LAST_FH = sub () { 0 }'; + } +} + # Returns a full stack backtrace starting from where it is # told. sub ret_backtrace { @@ -587,7 +596,16 @@ sub ret_backtrace { my %i = caller_info($i); $mess = "$err at $i{file} line $i{line}$tid_msg"; - if( defined $. ) { + if( $. ) { + # Use ${^LAST_FH} if available. + if (LAST_FH) { + if (${+LAST_FH}) { + $mess .= sprintf ", <%s> %s %d", + *${+LAST_FH}{NAME}, + ($/ eq "\n" ? "line" : "chunk"), $. + } + } + else { local $@ = ''; local $SIG{__DIE__}; eval { @@ -596,6 +614,7 @@ sub ret_backtrace { if($@ =~ /^Died at .*(, <.*?> (?:line|chunk) \d+).$/ ) { $mess .= $1; } + } } $mess .= "\.\n"; diff --git a/lib/warnings.pm b/lib/warnings.pm index afb7934ab5..43d3925936 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -452,8 +452,9 @@ sub __chk if ($has_level and @callers_bitmask) { # logic copied from util.c:mess_sv my $stuff = " at " . join " line ", (caller $i)[1,2]; - $stuff .= ", <" . *${^LAST_FH}{NAME} . "> " - . ($/ eq "\n" ? "line" : "chunk") . " $." + $stuff .= sprintf ", <%s> %s %d", + *${^LAST_FH}{NAME}, + ($/ eq "\n" ? "line" : "chunk"), $. if $. && ${^LAST_FH}; die "$message$stuff.\n" if $results[0]; return warn "$message$stuff.\n"; diff --git a/regen/warnings.pl b/regen/warnings.pl index 9c10f69464..69084239f1 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -768,8 +768,9 @@ sub __chk if ($has_level and @callers_bitmask) { # logic copied from util.c:mess_sv my $stuff = " at " . join " line ", (caller $i)[1,2]; - $stuff .= ", <" . *${^LAST_FH}{NAME} . "> " - . ($/ eq "\n" ? "line" : "chunk") . " $." + $stuff .= sprintf ", <%s> %s %d", + *${^LAST_FH}{NAME}, + ($/ eq "\n" ? "line" : "chunk"), $. if $. && ${^LAST_FH}; die "$message$stuff.\n" if $results[0]; return warn "$message$stuff.\n"; diff --git a/t/porting/cmp_version.t b/t/porting/cmp_version.t index 18b3e57510..0573e2f81d 100644 --- a/t/porting/cmp_version.t +++ b/t/porting/cmp_version.t @@ -19,6 +19,7 @@ BEGIN { @INC = '..' if -f '../TestInit.pm'; + @INC = '.' if -f './TestInit.pm'; } use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute use strict; -- Perl5 Master Repository