From: Vincent Pit 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/?p=perl%2Fmodules%2FB-RecDeparse.git;a=commitdiff_plain;h=9cd527f20a3c5db1da76cc84685929819e1cc136 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';