summaryrefslogtreecommitdiff
path: root/lib/utf8.t
diff options
context:
space:
mode:
authorÆvar Arnfjörð Bjarmason <avar@cpan.org>2014-04-02 15:53:18 +0000
committerÆvar Arnfjörð Bjarmason <avar@cpan.org>2014-04-02 16:00:05 +0000
commit64470437fdd8d4178fc69d2d0e3a526d2b7d5262 (patch)
tree49b0fed1a2e8f05fbdedb1ab62a179e9fdce3c0b /lib/utf8.t
parenta04e6aad3b10787abd99c78eeac04ca9f4b33d0b (diff)
downloadperl-64470437fdd8d4178fc69d2d0e3a526d2b7d5262.tar.gz
utf8: add tests for behavior change in v5.15.6-407-gc710240, and more
In v5.15.6-407-gc710240 Father Chrysostomos patched utf8::decode() so it would call SvPV_force_nolen() on its argument. This meant that calling utf8::decode() with a non-blessed non-overloaded reference would now coerce the reference scalar to a string, i.e. before we'd do: $ ./perl -Ilib -MDevel::Peek -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); Dump $s_ref; print $$s_ref' ævar 5.019011 SV = IV(0x2579fd8) at 0x2579fe8 REFCNT = 1 FLAGS = (PADMY,ROK) RV = 0x25c33d8 SV = PV(0x257ab08) at 0x25c33d8 REFCNT = 2 FLAGS = (PADMY,POK,pPOK) PV = 0x25a1338 "\303\246var"\0 CUR = 5 LEN = 16 ævar But after calling SvPV_force_nolen(sv) we'd instead do: $ ./perl -Ilib -MDevel::Peek -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); Dump $s_ref; print $$s_ref' ævar 5.019011 SV = PVIV(0x140e4b8) at 0x13e7fe8 REFCNT = 1 FLAGS = (PADMY,POK,pPOK) IV = 0 PV = 0x140c578 "SCALAR(0x14313d8)"\0 CUR = 17 LEN = 24 Can't use string ("SCALAR(0x14313d8)") as a SCALAR ref while "strict refs" in use at -e line 1. I think this is arguably the right thing to do, we wouln't actually utf8 decode the containing scalar so this reveals bugs in code that passed references to utf8::decode(), what you want is to do this instead: $ ./perl -CO -Ilib -MDevel::Peek -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($$s_ref); Dump $s_ref; print $$s_ref' ævar 5.019011 SV = IV(0x1aa8fd8) at 0x1aa8fe8 REFCNT = 1 FLAGS = (PADMY,ROK) RV = 0x1af23d8 SV = PV(0x1aa9b08) at 0x1af23d8 REFCNT = 2 FLAGS = (PADMY,POK,pPOK,UTF8) PV = 0x1ad0338 "\303\246var"\0 [UTF8 "\x{e6}var"] CUR = 5 LEN = 16 ævar However I think we should be more consistent here, e.g. we'll die when utf8::upgrade() gets passed a reference, but utf8::downgrade() just passes it through. I'll file a bug for that separately.
Diffstat (limited to 'lib/utf8.t')
-rw-r--r--lib/utf8.t39
1 files changed, 39 insertions, 0 deletions
diff --git a/lib/utf8.t b/lib/utf8.t
index b81b97b09e..5c03b31ee4 100644
--- a/lib/utf8.t
+++ b/lib/utf8.t
@@ -461,6 +461,45 @@ SKIP: {
}
{
+ # 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;
+ %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\xb6";
utf8::upgrade($a);