This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
APItest: Add tests for utf8_to_bytes()
authorKarl Williamson <khw@cpan.org>
Mon, 5 Feb 2018 04:47:09 +0000 (21:47 -0700)
committerKarl Williamson <khw@cpan.org>
Mon, 5 Feb 2018 05:39:37 +0000 (22:39 -0700)
MANIFEST
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/utf8_to_bytes.t [new file with mode: 0644]

index 96c8da5..4a5c649 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4394,6 +4394,7 @@ ext/XS-APItest/t/underscore_length.t      Test find_rundefsv()
 ext/XS-APItest/t/utf16_to_utf8.t       Test behaviour of utf16_to_utf8{,reversed}
 ext/XS-APItest/t/utf8.t                Tests for code in utf8.c
 ext/XS-APItest/t/utf8_setup.pl Tests for code in utf8.c
+ext/XS-APItest/t/utf8_to_bytes.t       Tests for code in utf8.c
 ext/XS-APItest/t/utf8_warn00.t Tests for code in utf8.c
 ext/XS-APItest/t/utf8_warn01.t Tests for code in utf8.c
 ext/XS-APItest/t/utf8_warn02.t Tests for code in utf8.c
index 0be5d95..5e67e7f 100644 (file)
@@ -1380,6 +1380,24 @@ bytes_cmp_utf8(bytes, utf8)
        RETVAL
 
 AV *
+test_utf8_to_bytes(bytes, lenp)
+        unsigned char * bytes
+        STRLEN lenp
+    PREINIT:
+        char * ret;
+    CODE:
+        RETVAL = newAV();
+        sv_2mortal((SV*)RETVAL);
+
+        ret = (char *) utf8_to_bytes(bytes, &lenp);
+        av_push(RETVAL, newSVpv(ret, 0));
+        av_push(RETVAL, newSViv(lenp));
+        av_push(RETVAL, newSVpv((const char *) bytes, 0));
+
+    OUTPUT:
+        RETVAL
+
+AV *
 test_utf8n_to_uvchr_msgs(s, len, flags)
         char *s
         STRLEN len
diff --git a/ext/XS-APItest/t/utf8_to_bytes.t b/ext/XS-APItest/t/utf8_to_bytes.t
new file mode 100644 (file)
index 0000000..4c03f84
--- /dev/null
@@ -0,0 +1,68 @@
+#!perl -w
+
+# This is a base file to be used by various .t's in its directory
+# It tests various malformed UTF-8 sequences and some code points that are
+# "problematic", and verifies that the correct warnings/flags etc are
+# generated when using them.  For the code points, it also takes the UTF-8 and
+# perturbs it to be malformed in various ways, and tests that this gets
+# appropriately detected.
+
+use strict;
+use Test::More;
+
+BEGIN {
+    require './t/utf8_setup.pl';
+    use_ok('XS::APItest');
+};
+
+$|=1;
+
+use Data::Dumper;
+
+my @well_formed = (
+            "\xE1",
+            "The quick brown fox jumped over the lazy dog",
+            "Ces systèmes de codage sont souvent incompatibles entre eux.  Ainsi, deux systèmes peuvent utiliser le même nombre pour deux caractères différents ou utiliser différents nombres pour le même caractère.",
+            "Kelimelerin m\xC3\xAAme caract\xC3\xA8re ve yaz\xC3\xB1abc",
+);
+
+my @malformed = (
+            "Kelimelerin m\xC3\xAAme caract\xC3\xA8re ve yaz\xC4\xB1abc",
+            "Kelimelerin m\xC3\xAAme caract\xC3\xA8re ve yaz\xC4\xB1\xC3\xA8abc",
+            "Kelimelerin m\xC3\xAAme caract\xC3re ve yazi\xC3\xA8abc",
+            "Kelimelerin m\xC3\xAAme caract\xA8 ve yazi\xC3\xA8abc",
+            "Kelimelerin m\xC3\xAAme caract\xC3\xA8\xC3re ve yazi\xC3\xA8abc",
+);
+
+for my $test (@well_formed) {
+    my $utf8 = $test;
+    utf8::upgrade($utf8);
+    my $utf8_length;
+    my $byte_length = length $test;
+
+    {
+        use bytes;
+        $utf8_length = length $utf8;
+    }
+
+    my $ret_ref = test_utf8_to_bytes($utf8, $utf8_length);
+
+    is ($ret_ref->[0], $test, "Successfully downgraded "
+                            . display_bytes($utf8));
+    is ($ret_ref->[1], $byte_length, "... And returned correct length("
+                                     . $byte_length . ")");
+}
+
+for my $test (@malformed) {
+    my $utf8 = $test;
+    my $utf8_length = length $test;
+
+    my $ret_ref = test_utf8_to_bytes($utf8, $utf8_length);
+
+    ok (! defined $ret_ref->[0], "Returned undef for malformed "
+                                . display_bytes($utf8));
+    is ($ret_ref->[1], -1, "... And returned length -1");
+    is ($ret_ref->[2], $utf8, "... And left the input unchanged");
+}
+
+done_testing();