From b625025e93c87eab6565ea086e7d9c60245d6bd3 Mon Sep 17 00:00:00 2001
From: Richard Leach <richardleach@users.noreply.github.com>
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