develooper Front page | perl.perl5.changes | Postings from February 2018

[perl.git] branch blead updated. v5.27.8-153-gae315a0a3c

From:
Karl Williamson
Date:
February 5, 2018 05:39
Subject:
[perl.git] branch blead updated. v5.27.8-153-gae315a0a3c
Message ID:
E1eiZVF-0001As-RK@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/ae315a0a3c51e68887704d4907bb6a502a6d4e3f?hp=0b13e5291ebd9c786dea21905e17886c5a310454>

- Log -----------------------------------------------------------------
commit ae315a0a3c51e68887704d4907bb6a502a6d4e3f
Author: Karl Williamson <khw@cpan.org>
Date:   Sun Feb 4 21:47:09 2018 -0700

    APItest: Add tests for utf8_to_bytes()

commit 8132136a878b27b9619d552278dd329a2f289bd4
Author: Karl Williamson <khw@cpan.org>
Date:   Sun Feb 4 21:44:17 2018 -0700

    APItest:t/utf8_setup.pl: Display printables as themselves
    
    Instead of the harder to read \xXX

-----------------------------------------------------------------------

Summary of changes:
 MANIFEST                         |  1 +
 ext/XS-APItest/APItest.xs        | 18 +++++++++++
 ext/XS-APItest/t/utf8_setup.pl   |  6 +++-
 ext/XS-APItest/t/utf8_to_bytes.t | 68 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 92 insertions(+), 1 deletion(-)
 create mode 100644 ext/XS-APItest/t/utf8_to_bytes.t

diff --git a/MANIFEST b/MANIFEST
index 96c8da5b5e..4a5c649e45 100644
--- 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
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 0be5d95310..5e67e7fa40 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1379,6 +1379,24 @@ bytes_cmp_utf8(bytes, utf8)
     OUTPUT:
 	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
diff --git a/ext/XS-APItest/t/utf8_setup.pl b/ext/XS-APItest/t/utf8_setup.pl
index ec7a5ce3d1..231b4d9494 100644
--- a/ext/XS-APItest/t/utf8_setup.pl
+++ b/ext/XS-APItest/t/utf8_setup.pl
@@ -11,7 +11,11 @@ sub isASCII { ord "A" == 65 }
 sub display_bytes_no_quotes {
     use bytes;
     my $string = shift;
-    return join("", map { sprintf("\\x%02x", ord $_) } split "", $string)
+    return join("", map {
+                          ($_ =~ /[[:print:]]/)
+                          ? $_
+                          : sprintf("\\x%02x", ord $_)
+                        } split "", $string)
 }
 
 sub display_bytes {
diff --git a/ext/XS-APItest/t/utf8_to_bytes.t b/ext/XS-APItest/t/utf8_to_bytes.t
new file mode 100644
index 0000000000..4c03f842f5
--- /dev/null
+++ b/ext/XS-APItest/t/utf8_to_bytes.t
@@ -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();

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About