diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-02-15 08:31:41 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-02-15 08:31:41 +0000 |
commit | cb36c7826069e46f7a72e79cb6e038763e4c7ca8 (patch) | |
tree | 4e116e3b583d563f56e888abc6117fb4902d69e7 /ext | |
parent | 58c2ef1935bc22d76403b75989b56de9eecb6730 (diff) | |
parent | 59ecbafad1ed6a69b6ea56aa837f49504fd5051a (diff) | |
download | perl-cb36c7826069e46f7a72e79cb6e038763e4c7ca8.tar.gz |
Integrate mainline
p4raw-id: //depot/perlio@14702
Diffstat (limited to 'ext')
-rw-r--r-- | ext/B/B/Deparse.pm | 12 | ||||
-rw-r--r-- | ext/B/t/deparse.t | 5 |
2 files changed, 10 insertions, 7 deletions
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 7710919453..19e798c5e0 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -3038,7 +3038,7 @@ sub re_uninterp_extended { # character escapes, but not delimiters that might need to be escaped sub escape_str { # ASCII, UTF8 my($str) = @_; - $str =~ s/(.)/ord($1)>255 ? sprintf("\\x{%x}", ord($1)) : $1/eg; + $str =~ s/(.)/ord($1) > 255 ? sprintf("\\x{%x}", ord($1)) : $1/eg; $str =~ s/\a/\\a/g; # $str =~ s/\cH/\\b/g; # \b means something different in a regex $str =~ s/\t/\\t/g; @@ -3046,8 +3046,8 @@ sub escape_str { # ASCII, UTF8 $str =~ s/\e/\\e/g; $str =~ s/\f/\\f/g; $str =~ s/\r/\\r/g; - $str =~ s/([\cA-\cZ])/'\\c' . chr(ord('@') + ord($1))/ge; - $str =~ s/([^[:print:]])/'\\' . sprintf("%03o", ord($1))/ge; + $str =~ s/([\cA-\cZ])/sprintf("\\c%c", ord('@') + ord($1))/ge; + $str =~ s/([[:^print:]])/sprintf("\\%03o", ord($1))/ge; return $str; } @@ -3055,8 +3055,8 @@ sub escape_str { # ASCII, UTF8 # Leave whitespace unmangled. sub escape_extended_re { my($str) = @_; - $str =~ s/(.)/ord($1)>255 ? sprintf("\\x{%x}", ord($1)) : $1/eg; - $str =~ s/([^[:print:]])/'\\' . sprintf("%03o", ord($1))/ge; + $str =~ s/(.)/ord($1) > 255 ? sprintf("\\x{%x}", ord($1)) : $1/eg; + $str =~ s/([[:^print:]])/sprintf("\\%03o", ord($1))/ge; $str =~ s/\n/\n\f/g; return $str; } @@ -3074,7 +3074,7 @@ sub re_unback { my($str) = @_; # the insane complexity here is due to the behaviour of "\c\" - $str =~ s/(^|[^\\]|\\c\\)(?<!\\c)\\(\\\\)*(?=[^[:print:]])/$1$2/g; + $str =~ s/(^|[^\\]|\\c\\)(?<!\\c)\\(\\\\)*(?=[[:^print:]])/$1$2/g; return $str; } diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t index 22bd782bf7..768257a264 100644 --- a/ext/B/t/deparse.t +++ b/ext/B/t/deparse.t @@ -15,7 +15,7 @@ use warnings; use strict; use Config; -print "1..16\n"; +print "1..17\n"; use B::Deparse; my $deparse = B::Deparse->new() or print "not "; @@ -184,3 +184,6 @@ $x{warn()}; # 13 my $foo; $_ .= <ARGV> . <$foo>; +#### +# 14 +my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ"; |