File: qr-72922.t

package info (click to toggle)
perl 5.42.0-2
  • links: PTS, VCS
  • area: main
  • in suites: experimental
  • size: 128,392 kB
  • sloc: perl: 534,963; ansic: 240,563; sh: 72,042; pascal: 6,934; xml: 2,428; yacc: 1,360; makefile: 1,197; cpp: 208; lisp: 1
file content (41 lines) | stat: -rw-r--r-- 1,101 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#!perl -w
use strict;

BEGIN {
    chdir 't' if -d 't';
    require './test.pl';
}

no warnings 'experimental::builtin';
use builtin 'weaken';

plan(tests => 14);

# [perl 72922]: A 'copy' of a Regex object which has magic should not crash
# When a Regex object was copied and the copy weaken then the original regex object
# could no longer be 'copied' with qr//

sub s1 {
    my $re = qr/abcdef/;
    my $re_copy1 = $re;
    my $re_weak_copy = $re;;
    weaken($re_weak_copy);
    my $re_copy2 = qr/$re/;

    my $str_re = "$re";
    is("$$re_weak_copy", $str_re, "weak copy equals original");
    is("$re_copy1", $str_re, "copy1 equals original");
    is("$re_copy2", $str_re, "copy2 equals original");

    my $refcnt_start = Internals::SvREFCNT($$re_weak_copy);

    undef $re;
    refcount_is $re_weak_copy, $refcnt_start - 1, "refcnt decreased";
    is("$re_weak_copy", $str_re, "weak copy still equals original");

    undef $re_copy2;
    refcount_is $re_weak_copy, $refcnt_start - 1, "refcnt not decreased";
    is("$re_weak_copy", $str_re, "weak copy still equals original");
}
s1();
s1();