t/re/overload.t

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