From 7d7892821ccfd0b84576fc06764ec467e8ca7678 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 30 Oct 2011 14:33:06 -0700
Subject: Add evalbytes function
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This function evaluates its argument as a byte string, regardless of
the internal encoding.  It croaks if the string contains characters
outside the byte range.  Hence evalbytes(" use utf8; '\xc4\x80' ")
will return "\x{100}", even if the original string had the UTF8 flag
on, and evalbytes(" '\xc4\x80' ") will return "\xc4\x80".

This has the side effect of fixing the deparsing of CORE::break under
‘use feature’ when there is an override.
---
 dist/B-Deparse/Deparse.pm | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

(limited to 'dist/B-Deparse/Deparse.pm')

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index b8b30f3729..428466b519 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -33,7 +33,10 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	     # version number bumped to 5.15.3, this can be reduced to
 	     # just test $] < 5.015003.
 	     ($] < 5.015002 || do { require B; exists(&B::OPpCONST_ARYBASE) })
-	     ? qw(OPpCONST_ARYBASE) : ());
+	     ? qw(OPpCONST_ARYBASE) : ()),
+	 ($] < 5.015005 &&
+	     ($] < 5.015004 || do { require B; exists(&B::OPpEVAL_BYTES) })
+	     ? qw(OPpEVAL_BYTES) : ());
 $VERSION = "1.09";
 use strict;
 use vars qw/$AUTOLOAD/;
@@ -44,7 +47,7 @@ BEGIN {
     # be to fake up a dummy constant that will never actually be true.
     foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER
 		OPpPAD_STATE RXf_SKIPWHITE CVf_LOCKED OPpREVERSE_INPLACE
-		PMf_NONDESTRUCT OPpCONST_ARYBASE)) {
+		PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) {
 	no strict 'refs';
 	*{$_} = sub () {0} unless *{$_}{CODE};
     }
@@ -1557,6 +1560,7 @@ my %feature_keywords = (
     when    => 'switch',
     default => 'switch',
     break   => 'switch',
+    evalbytes=>'evalbytes',
 );
 
 sub keyword {
@@ -1564,11 +1568,9 @@ sub keyword {
     my $name = shift;
     return $name if $name =~ /^CORE::/; # just in case
     if (exists $feature_keywords{$name}) {
-	return
-	  $self->{'hinthash'}
-	   && $self->{'hinthash'}{"feature_$feature_keywords{$name}"}
-	    ? $name
-	    : "CORE::$name";
+	return "CORE::$name"
+	 if !$self->{'hinthash'}
+	 || !$self->{'hinthash'}{"feature_$feature_keywords{$name}"}
     }
     if (
       $name !~ /^(?:chom?p|do|exec|glob|s(?:elect|ystem))\z/
@@ -1766,7 +1768,12 @@ sub pp_alarm { unop(@_, "alarm") }
 sub pp_sleep { maybe_targmy(@_, \&unop, "sleep") }
 
 sub pp_dofile { unop(@_, "do") }
-sub pp_entereval { unop(@_, "eval") }
+sub pp_entereval {
+    unop(
+      @_,
+      $_[1]->private & OPpEVAL_BYTES ? $_[0]->keyword('evalbytes') : "eval"
+    )
+}
 
 sub pp_ghbyname { unop(@_, "gethostbyname") }
 sub pp_gnbyname { unop(@_, "getnetbyname") }
-- 
cgit v1.2.1