This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix =~ $str_overloaded (5.10 regression)
authorFather Chrysostomos <sprout@cpan.org>
Sat, 29 Oct 2011 20:40:06 +0000 (13:40 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 29 Oct 2011 20:40:06 +0000 (13:40 -0700)
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.

lib/overload.t
pp_ctl.c

index 89d8af7..1021a5f 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 4983;
+plan tests => 5037;
 
 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;
index 71e2ff8..eb74840 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -205,9 +205,7 @@ PP(pp_regcomp)
            if (PL_op->op_flags & OPf_SPECIAL)
                PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
 
-           if (DO_UTF8(tmpstr)) {
-               assert (SvUTF8(tmpstr));
-           } else if (SvUTF8(tmpstr)) {
+           if (!DO_UTF8(tmpstr) && SvUTF8(tmpstr)) {
                /* Not doing UTF-8, despite what the SV says. Is this only if
                   we're trapped in use 'bytes'?  */
                /* Make a copy of the octet sequence, but without the flag on,