From b625025e93c87eab6565ea086e7d9c60245d6bd3 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 31 Oct 2022 21:20:08 +0000 Subject: Prefer scalar assignment to get caller's first return value Multiple forms of syntax can be used to obtain a package name from `caller`, which emits this as its first return value, and assign that name to a lexical scalar. The following each achieve the same result, but with varying efficiency: * `sub callme { my $package = caller(2); ...}` * `sub callme { my ($package) = caller(2); ...}` * `sub callme { my $package = (caller(2))[0]; ...}` In the first example, `pp_caller` determines only the package name and pushes it to the stack. In the other two examples, the other 10 of `caller`'s return values are calculated and pushed onto the stack, before being discarded. This commit changes non-CPAN-first instances of the latter two forms in core to the first form. Note: There is a special exception to the equivalence described above, when caller is use in list context within the DB package. Such a usage instance in regen/warnings.pl therefore remains unchanged. --- lib/Benchmark.pm | 6 +++--- lib/Class/Struct.pm | 4 ++-- lib/overload.pm | 6 +++--- lib/overload.t | 2 +- lib/warnings.pm | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) (limited to 'lib') diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index 3eeba79873..b68e96ad17 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -482,7 +482,7 @@ our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); clearcache clearallcache disablecache enablecache); %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ; -$VERSION = 1.23; +$VERSION = 1.24; # --- ':hireswallclock' special handling @@ -683,9 +683,9 @@ sub runloop { my($t0, $t1, $td); # before, after, difference # find package of caller so we can execute code there - my($curpack) = caller(0); + my $curpack = caller(0); my($i, $pack)= 0; - while (($pack) = caller(++$i)) { + while ($pack = caller(++$i)) { last if $pack ne $curpack; } diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm index 1fa0fb47c4..a574734e5c 100644 --- a/lib/Class/Struct.pm +++ b/lib/Class/Struct.pm @@ -14,7 +14,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(struct); -$VERSION = '0.67'; +$VERSION = '0.68'; my $print = 0; sub printem { @@ -84,7 +84,7 @@ sub struct { } else { $base_type = 'ARRAY'; - $class = (caller())[0]; + $class = caller(); @decls = @_; } diff --git a/lib/overload.pm b/lib/overload.pm index 2451e68f34..d782271296 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -3,7 +3,7 @@ package overload; use strict; no strict 'refs'; -our $VERSION = '1.36'; +our $VERSION = '1.37'; our %ops = ( with_assign => "+ - * / % ** << >> x .", @@ -54,14 +54,14 @@ sub OVERLOAD { } sub import { - my $package = (caller())[0]; + my $package = caller(); # *{$package . "::OVERLOAD"} = \&OVERLOAD; shift; $package->overload::OVERLOAD(@_); } sub unimport { - my $package = (caller())[0]; + my $package = caller(); shift; *{$package . "::(("} = \&nil; for (@_) { diff --git a/lib/overload.t b/lib/overload.t index c97b87cc37..3a2b50ed92 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -1100,7 +1100,7 @@ is("a$utfvar", "a".200.2.1); # 224 - overload via sv_2pv_flags # were to eval the overload code in the caller's namespace, the privatisation # would be quite transparent. package Hderef; -use overload '%{}' => sub { (caller(0))[0] eq 'Foo' ? $_[0] : die "zap" }; +use overload '%{}' => sub { caller(0) eq 'Foo' ? $_[0] : die "zap" }; package Foo; @Foo::ISA = 'Hderef'; sub new { bless {}, shift } diff --git a/lib/warnings.pm b/lib/warnings.pm index b0dc1037ed..80fc64e484 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ package warnings; -our $VERSION = "1.62"; +our $VERSION = "1.63"; # Verify that we're called correctly so that warnings will work. # Can't use Carp, since Carp uses us! @@ -443,7 +443,7 @@ sub __chk unless defined $offset; } else { - $category = (caller(1))[0] ; + $category = caller(1); $offset = $Offsets{$category}; Croaker("package '$category' not registered for warnings") unless defined $offset ; -- cgit v1.2.1