1. Shlomi Fish
  2. perl-XML-LibXML

Commits

Shlomi Fish  committed 195d5d2

Fix RT #91800.

  • Participants
  • Parent commits 3a73b7c
  • Branches default

Comments (0)

Files changed (4)

File Changes

View file
 Revision history for Perl extension XML::LibXML
 
+    - Fix "Threads still failing?" Bug report.
+        - https://rt.cpan.org/Ticket/Display.html?id=91800
+        - Thanks to Daniel for the bug report and a test case, and to
+        YOREEK for the patch.
+
 2.0110          Sat  1 Feb 15:59:54 IST 2014
     - Add "use strict;" and "use warnings;" to all modules (CPANTS).
     - MIN_PERL_VERSION (CPANTS).

File LibXML.xs

View file
 void
 DESTROY( node )
         SV * node
+    PREINIT:
+        int count;
+        SV *is_shared;
     CODE:
 #ifdef XML_LIBXML_THREADS
+    if ( (is_shared = get_sv("XML::LibXML::__threads_shared", 0)) == NULL ) {
+        is_shared = &PL_sv_undef;
+    }
+    if ( SvTRUE(is_shared) ) {
+        dSP;
+        ENTER;
+        SAVETMPS;
+        PUSHMARK(SP);
+        XPUSHs(node);
+        PUTBACK;
+        count = call_pv("threads::shared::is_shared", G_SCALAR);
+        SPAGAIN;
+        if (count != 1)
+            croak("Couldn't checks if the variable is shared or not\n");
+        is_shared = POPs;
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+        if (is_shared != &PL_sv_undef) {
+            XSRETURN_UNDEF;
+        }
+    }
 	if( PmmUSEREGISTRY ) {
 	  SvLOCK(PROXY_NODE_REGISTRY_MUTEX);
 	  PmmRegistryREFCNT_dec(SvPROXYNODE(node));

File MANIFEST

View file
 t/71overloads.t
 t/72destruction.t
 t/80registryleak.t
+t/90shared_clone_failed_rt_91800.t
 t/90stack.t
 t/90threads.t
 t/91unique_key.t

File t/90shared_clone_failed_rt_91800.t

View file
+use strict;
+use warnings;
+
+use Test::More;
+use Config;
+
+BEGIN
+{
+    my $will_run = 0;
+    if ( $Config{useithreads} )
+    {
+        if ($ENV{THREAD_TEST})
+        {
+            require threads;
+            require threads::shared;
+            $will_run = 1;
+        }
+        else
+        {
+            plan skip_all => "optional (set THREAD_TEST=1 to run these tests)";
+        }
+    }
+    else
+    {
+        plan skip_all => "no ithreads in this Perl";
+    }
+
+    if ($will_run)
+    {
+        plan tests => 3;
+    }
+}
+
+use XML::LibXML qw(:threads_shared);
+
+# TEST
+ok(1, 'Loaded');
+
+my $p = XML::LibXML->new();
+
+# TEST
+ok($p, 'Parser initted.');
+
+{
+    my $doc = $p->parse_string(qq{<root><foo id="1">bar</foo></root>});
+    my $cloned = threads::shared::shared_clone($doc);
+
+    # TEST
+    ok(1,  "Shared clone");
+}