From: Graham Knop <haarg@haarg.org>
Date: Thu, 19 Nov 2015 20:18:57 +0000 (-0500)
Subject: prefer Sub::Util to Sub::Name
X-Git-Tag: v0.23~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2f7f41532be5c3b60ba16e15c7d8edaefa2f3ceb;p=p5sagit%2FTry-Tiny.git

prefer Sub::Util to Sub::Name

Sub::Util can name subs as well, and is in core in newer versions.  Try
to use it instead of Sub::Name, although prefer Sub::Name if it is
already loaded.

Each module has some edge cases though.  Sub::Name has a memory leak
prior to 0.08.  Some systems can end up with a version of Sub::Util that
doesn't have the set_subname sub.  Check for these cases as well when
picking a module to use.

Also optimize out the sub naming if neither module is available.
---

diff --git a/dist.ini b/dist.ini
index df88c9c..fa1d1f1 100644
--- a/dist.ini
+++ b/dist.ini
@@ -18,6 +18,7 @@ Git::NextVersion_version_regexp = ^Try-Tiny-(.+)$
 skip = ^perl$
 ; tests for optional Sub::Name stuff
 skip = ^Sub::Name$
+skip = ^Sub::Util$
 ; tests optionally require Capture::Tiny
 skip = ^Capture::Tiny$
 
@@ -26,4 +27,4 @@ perl = 5.006
 
 [Prereqs / TestRecommends]
 Capture::Tiny = 0.12 ; capture_stderr
-Sub::Name = 0
+Sub::Util = 0
diff --git a/lib/Try/Tiny.pm b/lib/Try/Tiny.pm
index 4e8e06d..50f8e43 100644
--- a/lib/Try/Tiny.pm
+++ b/lib/Try/Tiny.pm
@@ -11,7 +11,21 @@ our @EXPORT = our @EXPORT_OK = qw(try catch finally);
 use Carp;
 $Carp::Internal{+__PACKAGE__}++;
 
-BEGIN { eval "use Sub::Name; 1" or *{subname} = sub {1} }
+BEGIN {
+  my $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname;
+  my $sn = $INC{'Sub/Name.pm'} && eval { Sub::Name->VERSION(0.08) };
+  unless ($su || $sn) {
+    $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname;
+    unless ($su) {
+      $sn = eval { require Sub::Name; Sub::Name->VERSION(0.08) };
+    }
+  }
+
+  *_subname = $su ? \&Sub::Util::set_subname
+            : $sn ? \&Sub::Name::subname
+            : sub { $_[1] };
+  *_HAS_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0};
+}
 
 # Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
 # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
@@ -53,9 +67,8 @@ sub try (&;@) {
 
   # name the blocks if we have Sub::Name installed
   my $caller = caller;
-  subname("${caller}::try {...} " => $try);
-  subname("${caller}::catch {...} " => $catch) if $catch;
-  subname("${caller}::finally {...} " => $_) foreach @finally;
+  _subname("${caller}::try {...} " => $try)
+    if _HAS_SUBNAME;
 
   # save the value of $@ so we can set $@ back to it in the beginning of the eval
   # and restore $@ after the eval finishes
@@ -116,6 +129,9 @@ sub catch (&;@) {
 
   croak 'Useless bare catch()' unless wantarray;
 
+  my $caller = caller;
+  _subname("${caller}::catch {...} " => $block)
+    if _HAS_SUBNAME;
   return (
     bless(\$block, 'Try::Tiny::Catch'),
     @rest,
@@ -127,6 +143,9 @@ sub finally (&;@) {
 
   croak 'Useless bare finally()' unless wantarray;
 
+  my $caller = caller;
+  _subname("${caller}::finally {...} " => $block)
+    if _HAS_SUBNAME;
   return (
     bless(\$block, 'Try::Tiny::Finally'),
     @rest,
diff --git a/t/named.t b/t/named.t
index 7de53b1..b6ba4e9 100644
--- a/t/named.t
+++ b/t/named.t
@@ -6,8 +6,9 @@ use warnings;
 use Test::More;
 
 BEGIN {
-    plan skip_all => "Sub::Name required"
-        unless eval { require Sub::Name; 1 };
+    plan skip_all => "Sub::Util or Sub::Name required"
+        unless eval { require Sub::Util; defined &Sub::Util::set_subname; }
+            || eval { require Sub::Name; Sub::Name->VERSION(0.08) };
     plan tests => 3;
 }