From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 29 Oct 2005 11:50:29 +0000 (+0000)
Subject: A terser implementation of S_varname, by using and post-processing
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9393da09e59f40413c9b2fe524636cab9c3d2221;p=p5sagit%2Fp5-mst-13.2.git

A terser implementation of S_varname, by using and post-processing
gv_fullname4

p4raw-id: //depot/perl@25874
---

diff --git a/sv.c b/sv.c
index 690dbe5..b5b8f95 100644
--- a/sv.c
+++ b/sv.c
@@ -675,30 +675,22 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
 
     SV * const name = sv_newmortal();
     if (gv) {
+	char buffer[2];
+	buffer[0] = gvtype;
+	buffer[1] = 0;
 
-	/* simulate gv_fullname4(), but add literal '^' for $^FOO names
-	 * XXX get rid of all this if gv_fullnameX() ever supports this
-	 * directly */
-
-	const char *p;
-	HV * const hv = GvSTASH(gv);
-	if (!hv)
-	    p = "???";
-	else if (!(p=HvNAME_get(hv)))
-	    p = "__ANON__";
-	if (strEQ(p, "main"))
-	    sv_setpvn(name, &gvtype, 1);
-	else
-	    Perl_sv_setpvf(aTHX_ name, "%c%s::", gvtype, p);
+	/* as gv_fullname4(), but add literal '^' for $^FOO names  */
+
+	gv_fullname4(name, gv, buffer, 0);
 
-	if (GvNAMELEN(gv)>= 1 &&
-	    ((unsigned int)*GvNAME(gv)) <= 26)
-	{ /* handle $^FOO */
-	    Perl_sv_catpvf(aTHX_ name,"^%c", *GvNAME(gv) + 'A' - 1);
-	    sv_catpvn(name,GvNAME(gv)+1,GvNAMELEN(gv)-1);
+	if ((unsigned int)SvPVX(name)[1] <= 26) {
+	    buffer[0] = '^';
+	    buffer[1] = SvPVX(name)[1] + 'A' - 1;
+
+	    /* Swap the 1 unprintable control character for the 2 byte pretty
+	       version - ie substr($name, 1, 1) = $buffer; */
+	    sv_insert(name, 1, 1, buffer, 2);
 	}
-	else
-	    sv_catpvn(name,GvNAME(gv),GvNAMELEN(gv));
     }
     else {
 	U32 unused;