t/re/qr-72922.t

   1 #!perl -w
   2 use strict;
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     require './test.pl';
   7     skip_all_if_miniperl("no dynamic loading on miniperl, no Scalar::Util");
   8 }
   9
  10 plan(tests => 14);
  11
  12 # [perl 72922]: A 'copy' of a Regex object which has magic should not crash
  13 # When a Regex object was copied and the copy weaken then the original regex object
  14 # could no longer be 'copied' with qr//
  15
  16 use Scalar::Util 'weaken';
  17 sub s1 {
  18     my $re = qr/abcdef/;
  19     my $re_copy1 = $re;
  20     my $re_weak_copy = $re;;
  21     weaken($re_weak_copy);
  22     my $re_copy2 = qr/$re/;
  23
  24     my $str_re = "$re";
  25     is("$$re_weak_copy", $str_re, "weak copy equals original");
  26     is("$re_copy1", $str_re, "copy1 equals original");
  27     is("$re_copy2", $str_re, "copy2 equals original");
  28
  29     my $refcnt_start = Internals::SvREFCNT($$re_weak_copy);
  30
  31     undef $re;
  32     is(Internals::SvREFCNT($$re_weak_copy), $refcnt_start - 1, "refcnt decreased");
  33     is("$re_weak_copy", $str_re, "weak copy still equals original");
  34
  35     undef $re_copy2;
  36     is(Internals::SvREFCNT($$re_weak_copy), $refcnt_start - 1, "refcnt not decreased");
  37     is("$re_weak_copy", $str_re, "weak copy still equals original");
  38 }
  39 s1();
  40 s1();