Commits

Anonymous committed 3e930e9

- Perl-thread support contributed by Tim Brody

Comments (0)

Files changed (7)

 Revision history for Perl extension XML::LibXML
 1.66pre
+   - Perl-thread support contributed by Tim Brody [rt.cpan.org #31945]
    - fix [rt.cpan.org #30610] possible segmentation fault when importing nodes from a document to an element created with XML::LibXML::Element->new
    - fix [rt.cpan.org #30261] Segmentation fault when extracting elements from an XML chunk
    - make Makefile.PL require Perl 5.6.1
+   - minor fixes and additions to the documentation 
 
 1.65
    - fix bug in t/40reader.t revealed by a bugfix in Test::More 0.71 (Jonathan Rockway)
 }
 
 #-------------------------------------------------------------------------#
+# 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                                        #
 #-------------------------------------------------------------------------#
 
     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:
             </author>
         </authorgroup>
 
-        <edition>1.64</edition>
+        <edition>1.66</edition>
 
         <copyright>
             <year>2001-2007</year>
             <para>In 1.59, a new callback API was introduced. This new API is not compatible with the previous one.
 	       See XML::LibXML::InputCallback manual page for details.</para>
  	    <para>In 1.61 the XML::LibXML::XPathContext module, previously distributed separately, was merged in.</para>
+	    <para>In 1.66, an experimental support for Perl threads has been implemented.</para>
         </sect1>
 
         <sect1>
  *         (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
     xmlNodePtr owner;
     int count;
     int encoding; 
+    struct _ProxyNode * _registry;
 };
 
 /* helper type for the proxy structure */
 #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.
  */
             proxy->owner   = NULL;
             proxy->count   = 0;
             proxy->encoding= 0;
+            proxy->_registry = NULL;
             node->_private = (void*) proxy;
+            PmmRegisterProxyNode(proxy);
         }
     }
     else {
                 
                 PmmFreeNode( libnode );
             }
+            PmmUnregisterProxyNode(node);
             Safefree( node );
             /* free( node ); */
         }
     xmlNodePtr owner;
     int count;
     int encoding;
+    struct _ProxyNode * _registry;
 };
 
 /* helper type for the proxy structure */
 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;
 <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)