APItest/t/utf8_warn_base.pl: Extract code into a fcn
authorKarl Williamson <khw@cpan.org>
Mon, 26 Jun 2017 03:35:05 +0000 (21:35 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 13 Jul 2017 03:14:25 +0000 (21:14 -0600)
This uses a function to test for a common paradigm.  The next couple of
commits will change that paradigm, and now the code will only have to
change in one place.

ext/XS-APItest/t/utf8_warn_base.pl

index c1ecf0e..737e731 100644 (file)
@@ -29,6 +29,17 @@ use warnings 'utf8';
 local $SIG{__WARN__} = sub { my @copy = @_;
                              push @warnings_gotten, map { chomp; $_ } @copy;
                            };
+
+sub requires_extended_utf8($) {
+
+    # Returns a boolean as to whether or not the code point parameter fits
+    # into 31 bits, subject to the convention that a negative code point
+    # stands for one that overflows the word size, so won't fit in 31 bits.
+
+    my $cp = shift;
+    return $cp > 0x7FFFFFFF;
+}
+
 my @tests;
 {
     no warnings qw(portable overflow);
@@ -607,7 +618,7 @@ foreach my $test (@tests) {
             $cp_message_qr = qr/\Q$non_cp_trailing_text\E/;
             $initially_malformed = 1;
         }
-        elsif ($allowed_uv > 0x7FFFFFFF) {
+        elsif (requires_extended_utf8($allowed_uv)) {
             $cp_message_qr = qr/\QCode point 0x$uv_string is not Unicode,\E
                                 \Q and not portable\E/x;
             $non_cp_trailing_text = "is for a non-Unicode code point, and is not portable";
@@ -778,7 +789,7 @@ foreach my $test (@tests) {
                 $expected_ret = 0;
             }
             elsif ($disallow_type == 2) {
-                next if ! $will_overflow && $allowed_uv < 0x80000000;
+                next if ! requires_extended_utf8($allowed_uv);
                 $disallow_flags = $::UTF8_DISALLOW_ABOVE_31_BIT;
                 $expected_ret = 0;
             }
@@ -1072,7 +1083,7 @@ foreach my $test (@tests) {
                         # points are tested for being above Unicode.  What's
                         # left to test is that the large code points do
                         # trigger the above-31-bit flags.
-                        next if ! $will_overflow && $allowed_uv < 0x80000000;
+                        next if ! requires_extended_utf8($allowed_uv);
                         next if $controlling_warning_category ne 'non_unicode';
                         $eval_warn = "no warnings; use warnings 'non_unicode'";
                         $expect_regular_warnings = 1;