Skip to content

Commit 5fa9972

Browse files
bookkhwilliamson
book
authored and
khwilliamson
committed
fix string comparisons with $] to use numeric comparison instead
The fix follows Zefram's suggestion from https://www.nntp.perl.org/group/perl.perl5.porters/2012/05/msg186846.html > On older perls, however, $] had a numeric value that was built up using > floating-point arithmetic, such as 5+0.006+0.000002. This would not > necessarily match the conversion of the complete value from string form > [perl #72210]. You can work around that by explicitly stringifying > $] (which produces a correct string) and having *that* numify (to a > correctly-converted floating point value) for comparison. I cultivate > the habit of always stringifying $] to work around this, regardless of > the threshold where the bug was fixed. So I'd write > > use if "$]" >= 5.014, warnings => "non_unicode"; Note that, because some of the files do a `use integer`, the numeric comparisons with $] a `no integer` needs to be done in a lexical scope around the comparison, to avoid truncation to integers, which spoils the comparisons. Hence the ugly `do { no integer ; ... }` in some places.
1 parent a0a3c55 commit 5fa9972

File tree

8 files changed

+19
-19
lines changed

8 files changed

+19
-19
lines changed

‎lib/Pod/Simple.pm

+4-4
Original file line numberDiff line numberDiff line change
@@ -33,17 +33,17 @@ BEGIN {
3333
die "MANY_LINES is too small (", MANY_LINES(), ")!\nAborting";
3434
}
3535
if(defined &UNICODE) { }
36-
elsif($] >= 5.008) { *UNICODE = sub() {1} }
37-
else { *UNICODE = sub() {''} }
36+
elsif( do { no integer; "$]" >= 5.008 } ) { *UNICODE = sub() {1} }
37+
else { *UNICODE = sub() {''} }
3838
}
3939
if(DEBUG > 2) {
4040
print STDERR "# We are ", ASCII ? '' : 'not ', "in ASCII-land\n";
4141
print STDERR "# We are under a Unicode-safe Perl.\n";
4242
}
4343

4444
# The NO BREAK SPACE and SOFT HYHPEN are used in several submodules.
45-
if ($] ge 5.007_003) { # On sufficiently modern Perls we can handle any
46-
# character set
45+
if ( do { no integer; "$]" >= 5.007_003 } ) { # On sufficiently modern Perls we can handle any
46+
# character set
4747
$Pod::Simple::nbsp = chr utf8::unicode_to_native(0xA0);
4848
$Pod::Simple::shy = chr utf8::unicode_to_native(0xAD);
4949
}

‎lib/Pod/Simple/BlackBox.pm

+5-5
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ sub my_qr ($$) {
3535
my ($input_re, $should_match) = @_;
3636
# XXX could have a third parameter $shouldnt_match for extra safety
3737

38-
my $use_utf8 = ($] le 5.006002) ? 'use utf8;' : "";
38+
my $use_utf8 = do { no integer; $] <= 5.006002 } ? 'use utf8;' : "";
3939

4040
my $re = eval "no warnings; $use_utf8 qr/$input_re/";
4141
#print STDERR __LINE__, ": $input_re: $@\n" if $@;
@@ -93,7 +93,7 @@ my $deprecated_re = my_qr('\p{IsDeprecated}', "\x{149}");
9393
$deprecated_re = qr/\x{149}/ unless $deprecated_re;
9494

9595
my $utf8_bom;
96-
if (($] ge 5.007_003)) {
96+
if ( do { no integer; "$]" >= 5.007_003 }) {
9797
$utf8_bom = "\x{FEFF}";
9898
utf8::encode($utf8_bom);
9999
} else {
@@ -266,13 +266,13 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
266266
# XXX probably if the line has E<foo> that evaluates to illegal CP1252,
267267
# then it is UTF-8. But we haven't processed E<> yet.
268268

269-
goto set_1252 if $] lt 5.006_000; # No UTF-8 on very early perls
269+
goto set_1252 if do { no integer; "$]" < 5.006_000 }; # No UTF-8 on very early perls
270270

271271
my $copy;
272272

273273
no warnings 'utf8';
274274

275-
if ($] ge 5.007_003) {
275+
if ( do { no integer; "$]" >= 5.007_003 } ) {
276276
$copy = $line;
277277

278278
# On perls that have this function, we can use it to easily see if the
@@ -286,7 +286,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
286286
}
287287
else { # ASCII, no decode(): do it ourselves using the fundamental
288288
# characteristics of UTF-8
289-
use if $] le 5.006002, 'utf8';
289+
use if do { no integer; "$]" <= 5.006002 }, 'utf8';
290290

291291
my $char_ord;
292292
my $needed; # How many continuation bytes to gobble up

‎lib/Pod/Simple/DumpAsXML.pm

+1-1
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ sub _handle_element_end {
6767
sub _xml_escape {
6868
foreach my $x (@_) {
6969
# Escape things very cautiously:
70-
if ($] ge 5.007_003) {
70+
if ("$]" >= 5.007_003) {
7171
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg;
7272
} else { # Is broken for non-ASCII platforms on early perls
7373
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;

‎lib/Pod/Simple/HTML.pm

+4-4
Original file line numberDiff line numberDiff line change
@@ -702,7 +702,7 @@ sub section_name_tidy {
702702
$section =~ s/^\s+//;
703703
$section =~ s/\s+$//;
704704
$section =~ tr/ /_/;
705-
if ($] ge 5.006) {
705+
if ("$]" >= 5.006) {
706706
$section =~ s/[[:cntrl:][:^ascii:]]//g; # drop crazy characters
707707
} elsif ('A' eq chr(65)) { # But not on early EBCDIC
708708
$section =~ tr/\x00-\x1F\x80-\x9F//d;
@@ -725,7 +725,7 @@ sub general_url_escape {
725725
# A pretty conservative escaping, behoovey even for query components
726726
# of a URL (see RFC 2396)
727727

728-
if ($] ge 5.007_003) {
728+
if ("$]" >= 5.007_003) {
729729
$string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',utf8::native_to_unicode(ord($1)))/eg;
730730
} else { # Is broken for non-ASCII platforms on early perls
731731
$string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg;
@@ -863,7 +863,7 @@ sub esc { # a function.
863863
@_ = splice @_; # break aliasing
864864
} else {
865865
my $x = shift;
866-
if ($] ge 5.007_003) {
866+
if ("$]" >= 5.007_003) {
867867
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg;
868868
} else { # Is broken for non-ASCII platforms on early perls
869869
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
@@ -874,7 +874,7 @@ sub esc { # a function.
874874
foreach my $x (@_) {
875875
# Escape things very cautiously:
876876
if (defined $x) {
877-
if ($] ge 5.007_003) {
877+
if ("$]" >= 5.007_003) {
878878
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg
879879
} else { # Is broken for non-ASCII platforms on early perls
880880
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg

‎lib/Pod/Simple/RTF.pm

+2-2
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ sub to_uni ($) { # Convert native code point to Unicode
1818
my $x = shift;
1919

2020
# Broken for early EBCDICs
21-
$x = chr utf8::native_to_unicode(ord $x) if $] ge 5.007_003
21+
$x = chr utf8::native_to_unicode(ord $x) if "$]" >= 5.007_003
2222
&& ord("A") != 65;
2323
return $x;
2424
}
@@ -551,7 +551,7 @@ my $other_unicode =
551551
Pod::Simple::BlackBox::my_qr('([\x{10000}-\x{10FFFF}])', "\x{10000}");
552552

553553
sub esc_uni($) {
554-
use if $] le 5.006002, 'utf8';
554+
use if do { no integer; "$]" <= 5.006002 }, 'utf8';
555555

556556
my $x = shift;
557557

‎lib/Pod/Simple/XMLOutStream.pm

+1-1
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ sub _handle_element_end {
7676
sub _xml_escape {
7777
foreach my $x (@_) {
7878
# Escape things very cautiously:
79-
if ($] ge 5.007_003) {
79+
if ("$]" >= 5.007_003) {
8080
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg;
8181
} else { # Is broken for non-ASCII platforms on early perls
8282
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;

‎t/ascii_order.pl

+1-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ ($)
55
my $string = shift;
66

77
return $string if ord("A") == 65
8-
|| $] lt 5.007_003; # Doesn't work on early EBCDIC Perls
8+
|| "$]" < 5.007_003; # Doesn't work on early EBCDIC Perls
99
my $output = "";
1010
for my $i (0 .. length($string) - 1) {
1111
$output .= chr(utf8::native_to_unicode(ord(substr($string, $i, 1))));

‎t/encod04.t

+1-1
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ use Pod::Simple::XMLOutStream;
1818
my $x97;
1919
my $x91;
2020
my $dash;
21-
if ($] ge 5.007_003) {
21+
if ("$]" >= 5.007_003) {
2222
$x97 = chr utf8::unicode_to_native(0x97);
2323
$x91 = chr utf8::unicode_to_native(0x91);
2424
$dash = '&#8212';

0 commit comments

Comments
 (0)