[perl #41618] Infinite recursion related to die, overloading, s/// and \x{...}

On Sun Feb 25 18:08:34 2007, sprout@cpan.org wrote:
> If the following hold true--
> 
>   - die is called outside an eval
>   - its argument is an object with overloaded stringification
>   - while the stringification subroutine is on the call stack a  
> substitution is performed
>   - the substitution's regexp contains [\x{d800}-\x{dbff}]
> 
> --then the substitution operator will automagically call the  
> stringification routine again with the same arguments, thereby  
> causing infinite recursion.
> 
> Here is a test script:
> 
> #!/usr/bin/perl -lw
> 
> no warnings 'once';
> 
> use Carp 'longmess';
> use overload '""' => sub {
> 	warn longmess if ++$count == 10;
> 
> 	my $x = 'thing'; # any string will trigger the bug
> 	$x =~ s/([\x{d800}-\x{dbff}])([\x{dc00}-\x{dfff}])/
> 		chr 0x10000 + (ord($1) - 0xD800) * 0x400 +
> 			(ord($2) - 0xDC00)
> 	/ge;
> 	$x
> };
> 
> $thing = bless [];
> die $thing;
> # die "$thing"; # this one works, because 'die' is not doing the  
> stringification
> 
> __END__
> 
> If I use s/[a-e]/b/g for the substitution, the bug is not triggered.  
> It's the [\x{d800}-\x{dbff}] that does it.
> 
> This bug exists in 5.9.4 as well as 5.8.8.
> 
> This is a really obscure bug--it took me a while to reproduce it. :-)
> 
> ---


This is still a problem on blead...

#!/usr/bin/perl -lw

no warnings 'once';

use Carp 'longmess';
use overload '""' => sub {
  my @z = @_;
# warn longmess if ++$count == 10;

  my $x = "thing\n"; # any string will trigger the bug
  $x =~
    s/([\x{d800}-\x{dbff}])([\x{dc00}-\x{dfff}])/
      chr 0x10000 + (ord($1) - 0xD800) * 0x400 + (ord($2) - 0xDC00)
    /ge;
  $x;
};

$thing = bless [];
die $thing;
__END__

Doesn't segfault



#!/usr/bin/perl -lw

no warnings 'once';

use Carp 'longmess';
use overload '""' => sub {
  my @z = @_;
# warn longmess if ++$count == 10;

  my $x = "thing\n"; # any string will trigger the bug
  $x =~
    s/([\x{d800}-\x{dbff}])([\x{dc00}-\x{dfff}])/
      chr 0x10000 + (ord($1) - 0xD800) * 0x400 + (ord($2) - 0xDC00)
    /ge;
  $x;
};


my $x = "thing\n"; # any string will trigger the bug
$x =~ s/([\x{d800}-\x{dbff}])([\x{dc00}-\x{dfff}])/
    chr 0x10000 + (ord($1) - 0xD800) * 0x400 + (ord($2) - 0xDC00)
  /ge;
print  $x;

$thing = bless [];
die $thing;
__END__

Does segfault



But:

#!/usr/bin/perl -lw

my $x = "thing\n"; # any string will trigger the bug
$x =~ s/([\x{d800}-\x{dbff}])([\x{dc00}-\x{dfff}])/
    chr 0x10000 + (ord($1) - 0xD800) * 0x400 + (ord($2) - 0xDC00)
  /ge;
print  $x;
__END__

Does not segfault.


Kind regards,

Bram

• [perl #41618] Infinite recursion related to die, overloading, s/// and \x{...} by Bram via RT