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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
use Test::More;
BEGIN { plan tests => 18 };
use warnings;
use strict;
BEGIN {$ENV{'DEBUG_MEMORY'} = 1;}
use XML::LibXML;
use XML::LibXML::Devel qw(:all);
$|=1;
# Base line
{
my $doc = XML::LibXML::Document->new();
my $raw;
my $mem_before = mem_used();
{
my $node = $doc->createTextNode("Hello");
$raw = node_from_perl($node);
refcnt_inc($raw);
}
cmp_ok(mem_used(), '>', $mem_before);
is(refcnt_dec($raw), 1);
is(mem_used(), $mem_before);
# Next group of checks - multiple nodes
my ($rawT, $rawN);
$mem_before = mem_used();
{
my $node = XML::LibXML::Element->new( 'text' );
my $text = $doc->createTextNode( "Hello" );
$rawN = node_from_perl($node);
$rawT = node_from_perl($text);
refcnt_inc($rawN);
refcnt_inc($rawT);
$node->appendChild($text);
# Done by appendChild
# fix_owner($rawT, $rawN);
}
cmp_ok(mem_used(), '>', $mem_before);
is(refcnt_dec($rawN), 2);
is(refcnt_dec($rawT), 1);
is(mem_used(), $mem_before);
# The owner node remains until the last node is gone
my ($rawR, $rawD);
$mem_before = mem_used();
{
my $dom = XML::LibXML->load_xml(string => <<'EOT');
<?xml version="1.0"?>
<test>
<text>Hello</text>
</test>
EOT
my ($root) = $dom->getElementsByTagName('test');
$rawR = node_from_perl($root);
$rawD = node_from_perl($dom);
is(refcnt($rawR), 1);
is(refcnt($rawD), 2);
my ($node) = $dom->getElementsByTagName('text');
$rawN = node_from_perl($node);
is(refcnt($rawN), 1);
is(refcnt($rawR), 1);
is(refcnt($rawD), 3);
refcnt_inc($rawN);
is(refcnt($rawD), 3);
my $child = $node->firstChild;
is(refcnt($rawD), 4);
}
cmp_ok(mem_used(), '>', $mem_before);
# $rawR's proxy node is no longer accessible
# but $rawD still has one
is(refcnt($rawD), 1);
is(refcnt_dec($rawN), 1);
is(mem_used(), $mem_before);
}
|
