BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
- require './test.pl';
+ require './test.pl'; require './charset_tools.pl';
unless ($has_perlio = find PerlIO::Layer 'perlio') {
print <<EOF;
# Since you don't have perlio you might get failures with UTF-8 locales.
my ($a, $b);
- { use bytes; $a = "\xc3\xa4" }
- { use utf8; $b = "\xe4" }
+ { use bytes; $a = byte_utf8a_to_utf8n("\xc3\xa4") }
+ { use utf8; $b = uni_to_native("\xe4") }
my $test = 68;
{
# Make sure utf8::decode respects copy-on-write [perl #91834].
# Hash keys are the easiest way to test this.
- my $name = "\x{c3}\x{b3}";
+ my $name = byte_utf8a_to_utf8n("\x{c3}\x{b3}");
my ($k1) = keys %{ { $name=>undef } };
my $k2 = $name;
utf8::decode($k1);
utf8::decode($k2);
my $h = { $k1 => 1, $k2 => 2 };
- is join('', keys $h), $k2, 'utf8::decode respects copy-on-write';
+ is join('', keys %$h), $k2, 'utf8::decode respects copy-on-write';
}
{
# Make sure utf8::decode does not modify read-only scalars
# [perl #91850].
- my $name = "\x{c3}\x{b3}";
+ my $name = byte_utf8a_to_utf8n("\x{c3}\x{b3}");
Internals::SvREADONLY($name, 1);
eval { utf8::decode($name) };
like $@, qr/^Modification of a read-only/,
{
# utf8::decode should stringify refs [perl #91852].
- package eieifg { use overload '""' => sub { "\x{c3}\x{b3}" },
+ package eieifg { use overload '""' => sub { main::byte_utf8a_to_utf8n("\x{c3}\x{b3}") },
fallback => 1 }
my $name = bless[], eieifg::;
utf8::decode($name);
- is $name, "\xf3", 'utf8::decode flattens references';
+ is $name, uni_to_native("\xf3"), 'utf8::decode flattens references';
}
{
- my $a = "456\xb6";
+ # What do the utf8::* functions do when given a reference? A test
+ # for a behavior change that made this start dying as of
+ # v5.15.6-407-gc710240 due to a fix for [perl #91852]:
+ #
+ # ./miniperl -Ilib -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); print $$s_ref' hlagh
+ my %expected = (
+ 'utf8::is_utf8' => { returns => "hlagh" },
+ 'utf8::valid' => { returns => "hlagh" },
+ 'utf8::encode' => { error => qr/Can't use string .*? as a SCALAR ref/},
+ 'utf8::decode' => { error => qr/Can't use string .*? as a SCALAR ref/},
+ 'utf8::upgrade' => { error => qr/Can't use string .*? as a SCALAR ref/ },
+ 'utf8::downgrade' => { returns => "hlagh" },
+ 'utf8::native_to_unicode' => { returns => "hlagh" },
+ 'utf8::unicode_to_native' => { returns => "hlagh" },
+ );
+ for my $func (sort keys %expected) { # sort just so it's deterministic wrt diffing *.t output
+ my $code = sprintf q[
+ use strict;
+ my $s = "hlagh";
+ my $r = \$s;
+ my $dummy = %s($r);
+ $$r;
+ ], $func;
+ my $ret = eval $code or my $error = $@;
+ if (my $error_rx = $expected{$func}->{error}) {
+ if (defined $error) {
+ like $error, $error_rx, "The $func function should die with an error matching $error_rx";
+ } else {
+ fail("We were expecting an error when calling the $func function but got a value of '$ret' instead");
+ }
+ } elsif (my $returns = $expected{$func}->{returns}) {
+ is($ret, $returns, "The $func function lives and returns '$returns' as expected");
+ } else {
+ die "PANIC: Internal Error"
+ }
+ }
+}
+
+{
+ my $a = "456" . uni_to_native("\xb6");
utf8::upgrade($a);
- my $b = "123456\xb6";
+ my $b = "123456" . uni_to_native("\xb6");
$b =~ s/^...//;
utf8::upgrade($b);
is($b, $a, "utf8::upgrade OffsetOK");
for my $pos (0..5) {
my $p;
- my $s = "A\xc8\x81\xe8\xab\x86\x{100}";
+ my $utf8_bytes = byte_utf8a_to_utf8n("\xc8\x81\xe3\xbf\xbf");
+ my $s = "A$utf8_bytes\x{100}";
chop($s);
pos($s) = $pos;
utf8::downgrade($s);
is(length($s), 6, "(pos $pos) len after utf8::downgrade");
is(pos($s), $pos, "(pos $pos) pos after utf8::downgrade");
- is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after utf8::downgrade");
+ is($s, "A$utf8_bytes","(pos $pos) str after utf8::downgrade");
utf8::decode($s);
is(length($s), 3, "(pos $pos) len after D; utf8::decode");
is(pos($s), undef, "(pos $pos) pos after D; utf8::decode");
- is($s, "A\x{201}\x{8ac6}", "(pos $pos) str after D; utf8::decode");
+ is($s, "A\x{201}\x{3fff}", "(pos $pos) str after D; utf8::decode");
utf8::encode($s);
is(length($s), 6, "(pos $pos) len after D; utf8::encode");
is(pos($s), undef, "(pos $pos) pos after D; utf8::encode");
- is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after D; utf8::encode");
+ is($s, "A$utf8_bytes","(pos $pos) str after D; utf8::encode");
- $s = "A\xc8\x81\xe8\xab\x86";
+ $s = "A$utf8_bytes";
pos($s) = $pos;
is(length($s), 6, "(pos $pos) len before utf8::upgrade");
utf8::upgrade($s);
is(length($s), 6, "(pos $pos) len after utf8::upgrade");
is(pos($s), $pos, "(pos $pos) pos after utf8::upgrade");
- is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after utf8::upgrade");
+ is($s, "A$utf8_bytes","(pos $pos) str after utf8::upgrade");
utf8::decode($s);
is(length($s), 3, "(pos $pos) len after U; utf8::decode");
is(pos($s), undef, "(pos $pos) pos after U; utf8::decode");
- is($s, "A\x{201}\x{8ac6}", "(pos $pos) str after U; utf8::decode");
+ is($s, "A\x{201}\x{3fff}", "(pos $pos) str after U; utf8::decode");
utf8::encode($s);
is(length($s), 6, "(pos $pos) len after U; utf8::encode");
is(pos($s), undef, "(pos $pos) pos after U; utf8::encode");
- is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after U; utf8::encode");
+ is($s, "A$utf8_bytes","(pos $pos) str after U; utf8::encode");
}
+SKIP: {
+ skip("Test only valid on ASCII platform", 1) unless $::IS_ASCII;
+ require Config;
+ skip("Test needs a B module, which is lacking in this Perl", 1)
+ if $Config::Config{'extensions'} !~ /\bB\b/;
+
+ my $out = runperl ( switches => ["-XMO=Concise"],
+ prog => 'utf8::unicode_to_native(0x41);
+ utf8::native_to_unicode(0x42)',
+ stderr => 1 );
+ unlike($out, qr/entersub/,
+ "utf8::unicode_to_native() and native_to_unicode() optimized out");
+}
+
+
# [perl #119043] utf8::upgrade should not croak on read-only COWs
for(__PACKAGE__) {
- # First make sure we have a COW, otherwise this test is useless.
- my $copy = $_;
- my @addrs = unpack "L!L!", pack "pp", $copy, $_;
- if ($addrs[0] != $addrs[1]) {
- fail("__PACKAGE__ did not produce a COW - if this change was "
- ."intentional, please provide me with another ro COW scalar")
- }
- else {
eval { utf8::upgrade($_) };
is $@, "", 'no error with utf8::upgrade on read-only COW';
- }
}
# This one croaks, but not because the scalar is read-only
eval "package \x{100};\n" . <<'END'
https://perl5.git.perl.org / perl5.git / blobdiff