From 84b9ff80b70a3a578676b7bd6a89d2c119999b49 Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Mon, 11 Nov 2019 16:46:56 -0500 Subject: Update Safe.pm to use tr/// to trigger loading utf8_heavy.pl. Fixes GH #17271 --- dist/Safe/Safe.pm | 2 +- dist/Safe/t/safeutf8.t | 6 +----- 2 files changed, 2 insertions(+), 6 deletions(-) (limited to 'dist/Safe') diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm index 3f4cb21065..23231b027c 100644 --- a/dist/Safe/Safe.pm +++ b/dist/Safe/Safe.pm @@ -67,7 +67,7 @@ require utf8; # particular code points don't cause it to load. # (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 $a = pack('U',0x100); my $b = chr 0x101; utf8::upgrade $b; $a =~ /$b/i }; +do { my $a = pack('U',0x100); $a =~ tr/\x{1234}//; }; # 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 9a87aa98c1..c58f7e5ad1 100644 --- a/dist/Safe/t/safeutf8.t +++ b/dist/Safe/t/safeutf8.t @@ -22,11 +22,7 @@ $safe->deny_only(); # Fails with "Undefined subroutine PLPerl::utf8::SWASHNEW called" # if SWASHNEW is not shared, else returns true if unicode logic is working. # (For early Perls we don't take into account EBCDIC, so will fail there -my $trigger = q{ my $a = pack('U',0xC4); my $b = chr } - . (($] lt 5.007_003) ? "" : 'utf8::unicode_to_native(') - . '0xE4' - . (($] lt 5.007_003) ? "" : ')') - . q{; utf8::upgrade $b; $a =~ /$b/i }; +my $trigger = q{ my $a = pack('U',0xC4); $a =~ tr/\x{1234}//rd }; ok $safe->reval( $trigger ), 'trigger expression should return true'; is $@, '', 'trigger expression should not die'; -- cgit v1.2.1