This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
B::perlstring - add support for \e (Fix #17526)
authorYves Orton <demerphq@gmail.com>
Tue, 4 Feb 2020 08:02:47 +0000 (09:02 +0100)
committerYves Orton <demerphq@gmail.com>
Tue, 4 Feb 2020 08:09:24 +0000 (09:09 +0100)
In daf6caf1ef25ff48f871fa1e53adcefc11bf1d08 karl made pv_uni_display()
use the available mnemonic escapes instead of using \x{} style escapes.

This broke B::perlstring() which has an exclusion list of such escapes
to passthrough, and it did not know about \e, so it produced "\\e"
instead of "\e", which of course does not round trip.

This in turn broke Sub::Quote, which in turn breaks Moo, which breaks
a lot of stuff. :-)

Unfortunately B::perlstring() had no tests to detect this, so we only
found out when we got a BBC report that happened to also ticklet this
bug.

This patch adds 'e' to the exclusion list, and also adds tests to see
that the the first 1024 unicode codepoints and all 255 non-unicode
codepoints can round trip through B::perlstring().

This should resolve #17526 and indirectly help us close #17245.

With this patch we bump B.pm to v1.80

MANIFEST
ext/B/B.pm
ext/B/B.xs
ext/B/t/perlstring.t [new file with mode: 0644]

index 00acbbf..1bbab6c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4108,6 +4108,7 @@ ext/B/t/optree_sort.t             inplace sort optimization regression
 ext/B/t/optree_specials.t      BEGIN, END, etc code
 ext/B/t/optree_varinit.t       my,our,local var init optimization
 ext/B/t/OptreeCheck.pm         optree comparison tool
+ext/B/t/perlstring.t   See if B::perlstring output roundtrips properly
 ext/B/t/pragma.t       See if user pragmas work.
 ext/B/t/showlex.t      See if B::ShowLex works
 ext/B/t/strict.t       See if B works with strict and warnings.
index f199a05..80c7f85 100644 (file)
@@ -20,7 +20,7 @@ sub import {
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.79';
+    $B::VERSION = '1.80';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
index b3d04b8..8a41265 100644 (file)
@@ -258,7 +258,7 @@ cstring(pTHX_ SV *sv, bool perlstyle)
                sv_catpvs(sstr, "\\@");
            else if (*s == '\\')
            {
-               if (memCHRs("nrftabx\\",*(s+1)))
+                if (memCHRs("nrftaebx\\",*(s+1)))
                    sv_catpvn(sstr, s++, 2);
                else
                    sv_catpvs(sstr, "\\\\");
diff --git a/ext/B/t/perlstring.t b/ext/B/t/perlstring.t
new file mode 100644 (file)
index 0000000..107a8d7
--- /dev/null
@@ -0,0 +1,41 @@
+#!./perl
+
+BEGIN {
+    unshift @INC, 't';
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+BEGIN  {
+    eval { require threads; threads->import; }
+}
+use Test::More;
+
+BEGIN { use_ok( 'B' ); }
+
+for my $do_utf8 (""," utf8") {
+    my $max = $do_utf8 ? 1024  : 255;
+    my @bad;
+    for my $cp ( 0 .. $max ) {
+        my $char= chr($cp);
+        utf8::upgrade($char);
+        my $escaped= B::perlstring($char);
+        my $evalled= eval $escaped;
+        push @bad, [ $cp, $evalled, $char, $escaped ] if $evalled ne $char;
+    }
+    is(0+@bad, 0, "Check if any$do_utf8 codepoints fail to round trip through B::perlstring()");
+    if (@bad) {
+        foreach my $tuple (@bad) {
+            my ( $cp, $evalled, $char, $escaped ) = @$tuple;
+            is($evalled, $char, "check if B::perlstring of$do_utf8 codepoint $cp round trips ($escaped)");
+        }
+    }
+}
+
+done_testing();