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