Index: perl-libxml-mm.c
===================================================================
--- perl-libxml-mm.c (revision 695)
+++ perl-libxml-mm.c (working copy)
@@ -101,6 +101,7 @@
* (in case of document fragments, they are not the same!)
* @count: this is the internal reference count!
* @encoding: this value is missing in libxml2's doc structure
+ * @_registry: used to build the proxy node registry
*
* Since XML::LibXML will not know, is a certain node is already
* defined in the perl layer, it can't shurely tell when a node can be
@@ -113,6 +114,7 @@
xmlNodePtr owner;
int count;
int encoding;
+ struct _ProxyNode * _registry;
};
/* helper type for the proxy structure */
@@ -134,6 +136,79 @@
#define PmmENCODING(node) node->encoding
#define PmmNodeEncoding(node) ((ProxyNodePtr)(node->_private))->encoding
#define PmmDocEncoding(node) (node->charset)
+
+/*
+ * registry of all current proxy nodes
+ */
+ProxyNodePtr PROXY_NODE_REGISTRY = NULL;
+
+/*
+ * @proxy: proxy node to register
+ *
+ * adds a proxy node to the proxy node registry
+ */
+void
+PmmRegisterProxyNode(ProxyNodePtr proxy)
+{
+ proxy->_registry = PROXY_NODE_REGISTRY;
+ PROXY_NODE_REGISTRY = proxy;
+}
+
+/*
+ * @proxy: proxy node to remove
+ *
+ * removes a proxy node from the proxy node registry
+ */
+void
+PmmUnregisterProxyNode(ProxyNodePtr proxy)
+{
+ ProxyNodePtr cur = PROXY_NODE_REGISTRY;
+ if( PROXY_NODE_REGISTRY == proxy ) {
+ PROXY_NODE_REGISTRY = proxy->_registry;
+ }
+ else {
+ while(cur->_registry != NULL)
+ {
+ if( cur->_registry == proxy )
+ {
+ cur->_registry = proxy->_registry;
+ break;
+ }
+ cur = cur->_registry;
+ }
+ }
+}
+
+/*
+ * increments all proxy node counters by one (called on thread spawn)
+ */
+void
+PmmCloneProxyNodes()
+{
+ ProxyNodePtr cur = PROXY_NODE_REGISTRY;
+ while(cur != NULL)
+ {
+ PmmREFCNT_inc(cur);
+ cur = cur->_registry;
+ }
+}
+
+/*
+ * returns the current number of proxy nodes in the registry
+ */
+int
+PmmProxyNodeRegistrySize()
+{
+ int i = 0;
+ ProxyNodePtr cur = PROXY_NODE_REGISTRY;
+ while(cur != NULL)
+ {
+ ++i;
+ cur = cur->_registry;
+ }
+ return i;
+}
+
/* creates a new proxy node from a given node. this function is aware
* about the fact that a node may already has a proxy structure.
*/
@@ -155,7 +230,9 @@
proxy->owner = NULL;
proxy->count = 0;
proxy->encoding= 0;
+ proxy->_registry = NULL;
node->_private = (void*) proxy;
+ PmmRegisterProxyNode(proxy);
}
}
else {
@@ -283,6 +360,7 @@
PmmFreeNode( libnode );
}
+ PmmUnregisterProxyNode(node);
Safefree( node );
/* free( node ); */
}
Index: LibXML.xs
===================================================================
--- LibXML.xs (revision 695)
+++ LibXML.xs (working copy)
@@ -1272,6 +1272,19 @@
xmlInitializeCatalog(); /* use catalog data */
#endif
+void
+_CLONE( class )
+ char * class
+ CODE:
+ PmmCloneProxyNodes();
+
+int
+_leaked_nodes()
+ CODE:
+ RETVAL = PmmProxyNodeRegistrySize();
+ OUTPUT:
+ RETVAL
+
char *
LIBXML_DOTTED_VERSION()
CODE:
Index: perl-libxml-mm.h
===================================================================
--- perl-libxml-mm.h (revision 695)
+++ perl-libxml-mm.h (working copy)
@@ -50,6 +50,7 @@
xmlNodePtr owner;
int count;
int encoding;
+ struct _ProxyNode * _registry;
};
/* helper type for the proxy structure */
Index: LibXML.pm
===================================================================
--- LibXML.pm (revision 695)
+++ LibXML.pm (working copy)
@@ -152,6 +152,14 @@
}
#-------------------------------------------------------------------------#
+# Threads support methods #
+#-------------------------------------------------------------------------#
+
+# threads doc says CLONE's API may change in future, which would break
+# an XS method prototype
+sub CLONE { XML::LibXML::_CLONE( $_[0] ) }
+
+#-------------------------------------------------------------------------#
# DOM Level 2 document constructor #
#-------------------------------------------------------------------------#
Index: t/80registryleak.t
===================================================================
--- t/80registryleak.t (revision 0)
+++ t/80registryleak.t (revision 0)
@@ -0,0 +1,23 @@
+use Test;
+BEGIN { plan tests => 3}
+END { ok(0) unless $loaded }
+use XML::LibXML;
+
+$loaded = 1;
+ok(1);
+
+my $p = XML::LibXML->new();
+ok($p);
+
+my $xml = <<EOX;
+<?xml version="1.0"?>
+<root><child/></root>
+EOX
+
+{
+my $doc = $p->parse_string($xml);
+my $root = $doc->documentElement;
+my $child = $root->firstChild;
+}
+
+ok(&XML::LibXML::_leaked_nodes == 0);
Index: t/90threads.t
===================================================================
--- t/90threads.t (revision 695)
+++ t/90threads.t (working copy)
@@ -2,12 +2,13 @@
use Config;
use constant MAX_THREADS => 10;
use constant MAX_LOOP => 50;
-use constant PLAN => 14;
+use constant PLAN => 16;
BEGIN {
plan tests => PLAN;
if( $Config{useithreads} ) {
if ($ENV{THREAD_TEST}) {
require threads;;
+ require threads::shared;
} else {
skip("optional (set THREAD_TEST=1 to run these tests)\n") for (1..PLAN);
exit;
@@ -38,6 +39,33 @@
<root><node><leaf/></node></root>
EOF
+# Spawn threads with a document in scope
+{
+my $doc = $p->parse_string( $xml );
+for(1..MAX_THREADS)
+{
+ threads->new(sub {});
+}
+$_->join for(threads->list);
+}
+ok(1);
+
+# Spawn threads that use document that has gone out of scope from where it was
+# created
+{
+my $waitfor : shared;
+{
+lock $waitfor;
+my $doc = $p->parse_string($xml);
+for(1..MAX_THREADS)
+{
+ threads->new(sub { lock $waitfor; $doc->toString; });
+}
+}
+$_->join for(threads->list);
+ok(1);
+}
+
# Parse a correct XML document
{
for(1..MAX_THREADS)
