From: Vincent Pit <vince@profvince.com>
Date: Sat, 1 Nov 2008 13:56:13 +0000 (+0100)
Subject: Only fool single_delim when we're coming from B::RecDeparse
X-Git-Tag: v0.04~3
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=9cd527f20a3c5db1da76cc84685929819e1cc136;p=perl%2Fmodules%2FB-RecDeparse.git

Only fool single_delim when we're coming from B::RecDeparse
---

diff --git a/MANIFEST b/MANIFEST
index dec8126..0c9b3e5 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -12,6 +12,7 @@ t/12-level.t
 t/13-prototypes.t
 t/14-refs.t
 t/20-compile.t
+t/21-single_delim.t
 t/90-boilerplate.t
 t/91-pod.t
 t/92-pod-coverage.t
diff --git a/lib/B/RecDeparse.pm b/lib/B/RecDeparse.pm
index 2698667..db96fd6 100644
--- a/lib/B/RecDeparse.pm
+++ b/lib/B/RecDeparse.pm
@@ -112,7 +112,7 @@ if (FOOL_SINGLE_DELIM) {
  no warnings 'redefine';
  *B::Deparse::single_delim = sub {
   my $body = $_[2];
-  if ($body =~ s/^$key//) {
+  if ((caller 1)[0] eq __PACKAGE__ and $body =~ s/^$key//) {
    return $body;
   } else {
    $oldsd->(@_);
diff --git a/t/21-single_delim.t b/t/21-single_delim.t
new file mode 100644
index 0000000..0ef571d
--- /dev/null
+++ b/t/21-single_delim.t
@@ -0,0 +1,15 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use B::RecDeparse;
+use B::Deparse;
+
+sub wut { "\x{1c}B::RecDeparse\x{1c}"->() }
+
+my $bd = B::Deparse->new();
+my $code = $bd->coderef2text(\&wut);
+like $code, qr/B::RecDeparse/, 'single_delim is only fooled when called from B::RecDeparse';