t/re/overload.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5 no  warnings 'syntax';
   6
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     @INC = '../lib';
  10 }
  11
  12 sub is;
  13 sub plan;
  14
  15 require './test.pl';
  16 plan tests => 3;
  17
  18 {
  19     # Bug #77084 points out a corruption problem when scalar //g is used
  20     # on overloaded objects.
  21
  22     my @realloc;
  23     my $TAG = "foo:bar";
  24     use overload '""' => sub {$TAG};
  25
  26     my $o = bless [];
  27     my ($one) = $o =~ /(.*)/g;
  28     push @realloc, "xxxxxx"; # encourage realloc of SV and PVX
  29     is $one, $TAG, "list context //g against overloaded object";
  30
  31
  32     my $r = $o =~ /(.*)/g;
  33     push @realloc, "yyyyyy"; # encourage realloc of SV and PVX
  34     is $1, $TAG, "scalar context //g against overloaded object";
  35
  36     local our $TODO = "Bug #77084";
  37
  38     $o =~ /(.*)/g;
  39     push @realloc, "zzzzzz"; # encourage realloc of SV and PVX
  40     is $1, $TAG, "void context //g against overloaded object";
  41 }
  42
  43
  44 __END__