X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7899b63654b47512c646e6ef0a2af80ca6d38530..8583f9b2e775844535777cc53dbb699218bb280e:/dist/Devel-PPPort/t/utf8.t

diff --git a/dist/Devel-PPPort/t/utf8.t b/dist/Devel-PPPort/t/utf8.t
index b2fae54..119553d 100644
--- a/dist/Devel-PPPort/t/utf8.t
+++ b/dist/Devel-PPPort/t/utf8.t
@@ -30,9 +30,9 @@ BEGIN {
     require 'testutil.pl' if $@;
   }
 
-  if (55) {
+  if (81) {
     load();
-    plan(tests => 55);
+    plan(tests => 81);
   }
 }
 
@@ -52,7 +52,7 @@ BEGIN { require warnings if "$]" gt '5.006' }
 
 # skip tests on 5.6.0 and earlier
 if ("$]" le '5.006') {
-    skip 'skip: broken utf8 support', 0 for 1..55;
+    skip 'skip: broken utf8 support', 0 for 1..81;
     exit;
 }
 
@@ -64,6 +64,15 @@ ok(&Devel::PPPort::isUTF8_CHAR("A",  0), 1);
 ok(&Devel::PPPort::isUTF8_CHAR("\x{100}",  -1), 0);
 ok(&Devel::PPPort::isUTF8_CHAR("\x{100}",  0), 2);
 
+if ("$]" lt '5.008') {
+    ok(1, 1) for 1 ..3
+}
+else {
+    ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
+    ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
+    ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
+}
+
 my $ret = &Devel::PPPort::utf8_to_uvchr("A");
 ok($ret->[0], ord("A"));
 ok($ret->[1], 1);
@@ -187,3 +196,64 @@ else {
     }
 }
 
+if ("$]" ge '5.008') {
+    BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } }
+
+    ok(Devel::PPPort::sv_len_utf8("aščť"), 4);
+    ok(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
+
+    my $str = "áíé";
+    utf8::downgrade($str);
+    ok(Devel::PPPort::sv_len_utf8($str), 3);
+    utf8::downgrade($str);
+    ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+    utf8::upgrade($str);
+    ok(Devel::PPPort::sv_len_utf8($str), 3);
+    utf8::upgrade($str);
+    ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+
+    tie my $scalar, 'TieScalarCounter', "é";
+
+    ok(tied($scalar)->{fetch}, 0);
+    ok(tied($scalar)->{store}, 0);
+    ok(Devel::PPPort::sv_len_utf8($scalar), 2);
+    ok(tied($scalar)->{fetch}, 1);
+    ok(tied($scalar)->{store}, 0);
+    ok(Devel::PPPort::sv_len_utf8($scalar), 3);
+    ok(tied($scalar)->{fetch}, 2);
+    ok(tied($scalar)->{store}, 0);
+    ok(Devel::PPPort::sv_len_utf8($scalar), 4);
+    ok(tied($scalar)->{fetch}, 3);
+    ok(tied($scalar)->{store}, 0);
+    ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+    ok(tied($scalar)->{fetch}, 3);
+    ok(tied($scalar)->{store}, 0);
+    ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+    ok(tied($scalar)->{fetch}, 3);
+    ok(tied($scalar)->{store}, 0);
+} else {
+    for (1..23) {
+        skip 'skip: no SV_NOSTEAL support', 0;
+    }
+}
+
+package TieScalarCounter;
+
+sub TIESCALAR {
+    my ($class, $value) = @_;
+    return bless { fetch => 0, store => 0, value => $value }, $class;
+}
+
+sub FETCH {
+    BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } }
+    my ($self) = @_;
+    $self->{fetch}++;
+    return $self->{value} .= "é";
+}
+
+sub STORE {
+    my ($self, $value) = @_;
+    $self->{store}++;
+    $self->{value} = $value;
+}
+