import Sub-Name 0.03 from CPAN

git-cpan-module:   Sub-Name
git-cpan-version:  0.03
git-cpan-authorid: XMATH
git-cpan-file:     authors/id/X/XM/XMATH/Sub-Name-0.03.tar.gz

diff --git a/Changes b/Changes
index 2958033..ad36e58 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 $Id: Changes,v 1.1 2004/08/18 17:53:45 xmath Exp $
 
-0.02 -- Wed Aug 18 19:51:36 CEST 2004
+0.03 -- Wed Feb 20 20:19 CET 2008
+    * Fixed crash when trying to rename xsubs
+    * As a side-effect, should work with 5.005 threads (untested)
+
+0.02 -- Wed Aug 18 19:51 CEST 2004
     * Fixed documentation, which erroneously mentioned the existance of
       two exported functions.

diff --git a/META.yml b/META.yml
index bd37368..469eb94 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Sub-Name
-version:      0.02
+version:      0.03
 version_from: lib/Sub/Name.pm
 installdirs:  site
 requires:

diff --git a/Name.xs b/Name.xs
index a338c3c..6a4dc32 100644 (file)
--- a/Name.xs
+++ b/Name.xs
@@ -8,9 +8,7 @@
 #include "perl.h"
 #include "XSUB.h"
 
-#ifdef USE_5005THREADS
-#error "Not compatible with 5.005 threads"
-#endif
+static MGVTBL subname_vtbl;
 
 MODULE = Sub::Name  PACKAGE = Sub::Name
 
@@ -58,6 +56,24 @@ subname(name, sub)
        }
        gv = (GV *) newSV(0);
        gv_init(gv, stash, name, s - name, TRUE);
-       av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
+#ifndef USE_5005THREADS
+       if (CvPADLIST(cv)) {
+               /* cheap way to refcount the gv */
+               av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
+       }
+#endif
+       else {
+               /* expensive way to refcount the gv */
+               MAGIC *mg = SvMAGIC(cv);
+               while (mg && mg->mg_virtual != &subname_vtbl)
+                       mg = mg->mg_moremagic;
+               if (!mg)
+                       mg = sv_magicext((SV *) cv, NULL, PERL_MAGIC_ext,
+                                       &subname_vtbl, NULL, 0);
+               if (mg->mg_flags & MGf_REFCOUNTED)
+                       SvREFCNT_dec(mg->mg_obj);
+               mg->mg_flags |= MGf_REFCOUNTED;
+               mg->mg_obj = (SV *) gv;
+       }
        CvGV(cv) = gv;
        PUSHs(sub);

diff --git a/lib/Sub/Name.pm b/lib/Sub/Name.pm
index f5881be..9d9b757 100644 (file)
--- a/lib/Sub/Name.pm
+++ b/lib/Sub/Name.pm
@@ -46,7 +46,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 use base 'Exporter';
 use base 'DynaLoader';

diff --git a/t/smoke.t b/t/smoke.t
index 5c13ecc..27d843c 100644 (file)
--- a/t/smoke.t
+++ b/t/smoke.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN { print "1..3\n"; }
+BEGIN { print "1..5\n"; }
 
 
 use Sub::Name;
@@ -19,6 +19,12 @@ print $x->() eq "Blork:: Bar!" ? "ok 2\n" : "not ok 2\n";
 subname "Foo::Bar::Baz", $x;
 print $x->() eq "Foo::Bar::Baz" ? "ok 3\n" : "not ok 3\n";
 
+subname "subname (dynamic $_)", \&subname  for 1 .. 3;
+
+for (4 .. 5) {
+       subname "Dynamic $_", $x;
+       print $x->() eq "Blork::Dynamic $_" ? "ok $_\n" : "not ok $_\n";
+}
 
 # $Id: smoke.t,v 1.4 2004/08/18 12:03:42 xmath Exp $
 # vim: ft=perl