From: Matthijs van Duin <xmath-no-spam@nospam.cpan.org>
Date: Wed, 20 Feb 2008 19:24:24 +0000 (-0800)
Subject: import Sub-Name 0.03 from CPAN
X-Git-Tag: 0.03
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bbd0130659727a45e7f214cb8086cddbaecd5dec;p=p5sagit%2FSub-Name.git

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
--- 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
--- 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
--- 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
--- 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
--- 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