From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Tue, 9 Mar 2010 10:06:43 +0000 (+0100)
Subject: More backwards-compatible way to force loading of SWASHNEW in Safe
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=40b46ab8063dafd3563b817d72d1aaae426f27f0;p=p5sagit%2Fp5-mst-13.2.git

More backwards-compatible way to force loading of SWASHNEW in Safe
---

diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index cc87280..59b59e8 100644
--- a/dist/Safe/Safe.pm
+++ b/dist/Safe/Safe.pm
@@ -66,7 +66,7 @@ require utf8;
 # and also loads the ToFold SWASH.
 # (Swashes are cached internally by perl in PL_utf8_* variables
 # independent of being inside/outside of Safe. So once loaded they can be)
-do { my $unicode = pack('U',0xC4).'1a'; $unicode =~ /\xE4/i; };
+do { my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };
 # now we can safely include utf8::SWASHNEW in $default_share defined below.
 
 my $default_root  = 0;
diff --git a/dist/Safe/t/safeutf8.t b/dist/Safe/t/safeutf8.t
index 28441da..42b84ef 100644
--- a/dist/Safe/t/safeutf8.t
+++ b/dist/Safe/t/safeutf8.t
@@ -16,12 +16,12 @@ use Opcode qw(full_opset);
 pass;
 
 my $safe = Safe->new('PLPerl');
-$safe->permit(qw(pack));
+$safe->deny_only();
 
 # Expression that triggers require utf8 and call to SWASHNEW.
 # Fails with "Undefined subroutine PLPerl::utf8::SWASHNEW called"
 # if SWASHNEW is not shared, else returns true if unicode logic is working.
-my $trigger = q{ my $a = pack('U',0xC4); $a =~ /\\xE4/i };
+my $trigger = q{ my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };
 
 ok $safe->reval( $trigger ), 'trigger expression should return true';
 is $@, '', 'trigger expression should not die';