This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Warn on too high a code point if portable warn enabled
authorKarl Williamson <khw@cpan.org>
Sat, 11 Jan 2020 17:00:32 +0000 (10:00 -0700)
committerKarl Williamson <khw@cpan.org>
Thu, 23 Jan 2020 22:46:55 +0000 (15:46 -0700)
"use warnings 'portable'" is supposed to warn if a value won't fit on a
32 bit platform.  For the UTF-8 conversion functions it wasn't.  This is
still overridden if the flags to these functions call for no warnings to
be generated, but this commit changes it so that if the portable
category is enabled, but not the non_unicode category, warnings are
generated for the code points that won't work on a 32-bit platform.

ext/XS-APItest/t/utf8_warn_base.pl
pod/perldelta.pod
pod/perldiag.pod
utf8.c

index 34e8221..6a4026f 100644 (file)
@@ -1645,7 +1645,7 @@ foreach my $test (@tests) {
 
               # We classify the warnings into certain "interesting" types,
               # described later
-              foreach my $warning_type (0..4) {
+              foreach my $warning_type (0..5) {
                 next if $skip_most_tests && $warning_type != 1;
                 foreach my $use_warn_flag (0, 1) {
                     if ($use_warn_flag) {
@@ -1709,8 +1709,9 @@ foreach my $test (@tests) {
                             = $controlling_warning_category eq 'non_unicode';
                         $expect_warnings_for_malformed = $which_func;
                     }
-                    elsif ($warning_type == 4) {  # Like type 3, but uses the
-                                                  # PERL_EXTENDED flags
+                    elsif ($warning_type =~ /^[45]$/) {
+                        # Like type 3, but uses the PERL_EXTENDED flags, and 5
+                        # uses PORTABLE warnings;
                         # The complement flags were set up so that the
                         # PERL_EXTENDED flags have been tested that they don't
                         # trigger wrongly for too small code points.  And the
@@ -1720,7 +1721,13 @@ foreach my $test (@tests) {
                         # trigger the PERL_EXTENDED flags.
                         next if ! requires_extended_utf8($allowed_uv);
                         next if $controlling_warning_category ne 'non_unicode';
-                        $eval_warn = "no warnings; use warnings 'non_unicode'";
+                        $eval_warn = "no warnings;";
+                        if ($warning_type == 4) {
+                            $eval_warn .= " use warnings 'non_unicode'";
+                        }
+                        else {
+                            $eval_warn .= " use warnings 'portable'";
+                        }
                         $expect_regular_warnings = 1;
                         $expect_warnings_for_overflow = 1;
                         $expect_warnings_for_malformed = 0;
index 7b406ef..cac576a 100644 (file)
@@ -207,7 +207,14 @@ XXX L<message|perldiag/"message">
 
 =item *
 
-XXX L<message|perldiag/"message">
+L<Code point 0x%X is not Unicode, and not portable|perldiag/"Code point 0x%X is not Unicode, and not portable">
+
+This is actually not a new message, but it is now output when the
+warnings category C<portable> is enabled.
+
+=item *
+
+L<message|perldiag/"message">
 
 =back
 
index d50f6d8..3830003 100644 (file)
@@ -1731,10 +1731,13 @@ another template code following the slash.  See L<perlfunc/pack>.
 
 =item Code point 0x%X is not Unicode, and not portable
 
-(S non_unicode) You had a code point that has never been in any
+(S non_unicode portable) You had a code point that has never been in any
 standard, so it is likely that languages other than Perl will NOT
-understand it.  At one time, it was legal in some standards to have code
-points up to 0x7FFF_FFFF, but not higher, and this code point is higher.
+understand it.  This code point also will not fit in a 32-bit word on
+ASCII platforms and therefore is non-portable between systems.
+
+At one time, it was legal in some standards to have code points up to
+0x7FFF_FFFF, but not higher, and this code point is higher.
 
 Acceptance of these code points is a Perl extension, and you should
 expect that nothing other than Perl can handle them; Perl itself on
diff --git a/utf8.c b/utf8.c
index 1634ea4..d426635 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -340,6 +340,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs)
             /* Choose the more dire applicable warning */
             if (UNICODE_IS_PERL_EXTENDED(uv)) {
                 format = perl_extended_cp_format;
+                category = packWARN2(WARN_NON_UNICODE, WARN_PORTABLE);
                 if (flags & (UNICODE_WARN_PERL_EXTENDED
                             |UNICODE_DISALLOW_PERL_EXTENDED))
                 {
@@ -351,8 +352,11 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs)
                 *msgs = new_msg_hv(Perl_form(aTHX_ format, uv),
                                    category, flag);
             }
-            else {
-                Perl_ck_warner_d(aTHX_ category, format, uv);
+            else if (    ckWARN_d(WARN_NON_UNICODE)
+                     || (   (flag & UNICODE_GOT_PERL_EXTENDED)
+                         && ckWARN(WARN_PORTABLE)))
+            {
+                Perl_warner(aTHX_ category, format, uv);
             }
         }
         if (       (flags & UNICODE_DISALLOW_SUPER)
@@ -2087,9 +2091,10 @@ Perl__utf8n_to_uvchr_msgs_helper(const U8 *s,
                 if (UNLIKELY(isUTF8_PERL_EXTENDED(s0))) {
                     if (  ! (flags & UTF8_CHECK_ONLY)
                         &&  (flags & (UTF8_WARN_PERL_EXTENDED|UTF8_WARN_SUPER))
-                        &&  (msgs || ckWARN_d(WARN_NON_UNICODE)))
+                        &&  (msgs || (   ckWARN_d(WARN_NON_UNICODE)
+                                      || ckWARN(WARN_PORTABLE))))
                     {
-                        pack_warn = packWARN(WARN_NON_UNICODE);
+                        pack_warn = packWARN2(WARN_NON_UNICODE, WARN_PORTABLE);
 
                         /* If it is an overlong that evaluates to a code point
                          * that doesn't have to use the Perl extended UTF-8, it