view release on metacpan or  search on metacpan

xt/class_pv_magic.t  view on Meta::CPAN

my $CLASS = 'Data::BitSet::Shared';
# Decoy: 'Data::BitSet::ShareQ' - one character off $CLASS so it is the same
# string length and lands in the same malloc size class.

{ package ReallocClass;
  # A scalar whose FETCH relocates the PV buffer of the class variable it was
  # given a reference to, writes a decoy package name into the freed chunk,
  # then restores the class variable, so a corrected re-read sees the right
  # string while the stale pointer sees the decoy.
  sub TIESCALAR { my ($pkg, $classref, $retval) = @_; bless { cr => $classref, rv => $retval }, $pkg }
  sub FETCH {
      my $s = shift;
      ${ $s->{cr} } = 'P' x 100_000;   # grow: PV buffer moves, old chunk freed
      $s->{decoy} = join '', 'Data::BitSet', '::ShareQ';  # private PV: reuses the freed chunk
      ${ $s->{cr} } = $CLASS;          # restore: shorter, reuses big buffer
      $s->{rv};
  }
}

# Keep the class chunk away from the top of the heap so the grow above cannot