diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-10-29 13:40:06 -0700 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2012-06-13 13:25:51 +0100 |
commit | 540576b3757fd880b3435372fbd5b915e6781086 (patch) | |
tree | a9102fb9773333209afd974a236ae0f42c1f10e0 /lib/overload.t | |
parent | 21f84aaf83067e74dbc0efaeac7c2072f4335f53 (diff) | |
download | perl-540576b3757fd880b3435372fbd5b915e6781086.tar.gz |
Fix =~ $str_overloaded (5.10 regression)
[ DAPM: I just cherry-picked the tests from this commit, since my own
changes have already fixed this bug. FC's two commits:
15d9c083b08647e489d279a1059b4f14a3df187b
3e1022372a8200bc4c7354e0f588c7f71584a888
were unrolled at the start of this branch since they clashed with my own
stuff; this commit is re-adding the bits of those commits that are
still needed: i.e. just the tests.
]
In 5.8.x, this code:
use overload '""'=>sub { warn "stringify"; --$| ? "gonzo" : chr 256 };
my $obj = bless\do{my $x};
warn "$obj";
print "match\n" if chr(256) =~ $obj;
prints
stringify at - line 1.
gonzo at - line 3.
stringify at - line 1.
match
which is to be expected.
In 5.10+, the stringification happens one extra time, causing a failed match:
stringify at - line 1.
gonzo at - line 3.
stringify at - line 1.
stringify at - line 1.
This logic in pp_regcomp is faulty:
if (DO_UTF8(tmpstr)) {
assert (SvUTF8(tmpstr));
} else if (SvUTF8(tmpstr)) {
... copy under ‘use bytes’...
}
else if (SvAMAGIC(tmpstr)) {
/* make a copy to avoid extra stringifies */
tmpstr = newSVpvn_flags(t, len, SVs_TEMP | SvUTF8(tmpstr));
}
The SvAMAGIC check never happens when the UTF8 flag is on.
Diffstat (limited to 'lib/overload.t')
-rw-r--r-- | lib/overload.t | 4 |
1 files changed, 3 insertions, 1 deletions
diff --git a/lib/overload.t b/lib/overload.t index b9316207ea..16a7486877 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -48,7 +48,7 @@ package main; $| = 1; BEGIN { require './test.pl' } -plan tests => 4995; +plan tests => 5049; use Scalar::Util qw(tainted); @@ -1793,6 +1793,8 @@ foreach my $op (qw(<=> == != < <= > >=)) { # note: this is testing unary qr, not binary =~ $subs{qr} = '(qr/%s/)'; push @tests, [ "abc", '"abc" =~ (%s)', '(qr)', '("")', [ 1, 2, 0 ], 0 ]; + push @tests, [ chr 256, 'chr(256) =~ (%s)', '(qr)', '("")', + [ 1, 2, 0 ], 0 ]; $e = '"abc" ~~ (%s)'; $subs{'~~'} = $e; |