This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
APItest: Add tests for valid_utf8_to_uvchr
authorKarl Williamson <khw@cpan.org>
Fri, 13 Nov 2015 16:35:19 +0000 (09:35 -0700)
committerKarl Williamson <khw@cpan.org>
Sun, 6 Dec 2015 05:42:08 +0000 (22:42 -0700)
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/utf8.t

index efe6da3..ebdef68 100644 (file)
@@ -1393,6 +1393,34 @@ test_utf8n_to_uvchr(s, len, flags)
     OUTPUT:
         RETVAL
 
+AV *
+test_valid_utf8_to_uvchr(s)
+
+        SV *s
+    PREINIT:
+        STRLEN retlen;
+        UV ret;
+        STRLEN slen;
+
+    CODE:
+        /* Call utf8n_to_uvchr() with the inputs.  It always asks for the
+         * actual length to be returned
+         *
+         * Length to assume <s> is; not checked, so could have buffer overflow
+         */
+        RETVAL = newAV();
+        sv_2mortal((SV*)RETVAL);
+
+        ret
+         = valid_utf8_to_uvchr((U8*) SvPV(s, slen), &retlen);
+
+        /* Returns the return value in [0]; <retlen> in [1] */
+        av_push(RETVAL, newSVuv(ret));
+        av_push(RETVAL, newSVuv(retlen));
+
+    OUTPUT:
+        RETVAL
+
 SV *
 test_uvchr_to_utf8_flags(uv, flags)
 
index 1e1c984..9b5ed9b 100644 (file)
@@ -402,6 +402,18 @@ for my $u (sort { utf8::unicode_to_native($a) <=> utf8::unicode_to_native($b) }
         diag "The warnings were: " . join(", ", @warnings);
     }
 
+    undef @warnings;
+
+    $ret_ref = test_valid_utf8_to_uvchr($bytes);
+    is($ret_ref->[0], $n, "Verify valid_utf8_to_uvchr($display_bytes) returns $hex_n");
+    is($ret_ref->[1], $len, "Verify valid_utf8_to_uvchr() for $hex_n returns expected length");
+
+    unless (is(scalar @warnings, 0,
+               "Verify valid_utf8_to_uvchr() for $hex_n generated no warnings"))
+    {
+        diag "The warnings were: " . join(", ", @warnings);
+    }
+
     # Similarly for uvchr_to_utf8
     my $this_uvchr_flags = $look_for_everything_uvchr_to;
     if ($n > 2 ** 31 - 1) {