This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/Safe/t/safeutf8.t: Fix to work on early Perls
authorKarl Williamson <khw@cpan.org>
Tue, 10 Mar 2015 20:53:05 +0000 (14:53 -0600)
committerKarl Williamson <khw@cpan.org>
Fri, 13 Mar 2015 16:53:11 +0000 (10:53 -0600)
In commit fedc1b0e2d9cec34b7e3b1fa65dd0f7eb4f539fd, I forgot that this
is dual-lifed and may be used on early Perls.  This commit allows that,
but it will fail if such a Perl were to be used on an EBCDIC platform.

dist/Safe/t/safeutf8.t

index 6521c9c..9a87aa9 100644 (file)
@@ -21,7 +21,12 @@ $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); my $b = chr utf8::unicode_to_native(0xE4); utf8::upgrade $b; $a =~ /$b/i };
+# (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 };
 
 ok $safe->reval( $trigger ), 'trigger expression should return true';
 is $@, '', 'trigger expression should not die';