perl 5.003_04: dump.c gv.c op.c pp_ctl.c pp_sys.c proto.h run.c

This patch changes neither behavior nor performance.  However, it does
reduce code size and improve maintainability by combining some common
code in gv_fullname() and gv_efullname().

diff --git a/dump.c b/dump.c
index a490383..4c00ad3 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -67,7 +67,7 @@ GV* gv;
 {
     SV *sv = sv_newmortal();
 
-    gv_fullname(sv,gv);
+    gv_fullname(sv, gv, Nullch);
     dump("\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))
        dump("(xsub 0x%x %d)\n",
@@ -85,7 +85,7 @@ GV* gv;
 {
     SV *sv = sv_newmortal();
 
-    gv_fullname(sv,gv);
+    gv_fullname(sv, gv, Nullch);
     dump("\nFORMAT %s = ", SvPVX(sv));
     if (CvROOT(GvFORM(gv)))
        dump_op(CvROOT(GvFORM(gv)));
@@ -223,7 +223,7 @@ register OP *op;
            ENTER;
            tmpsv = NEWSV(0,0);
            SAVEFREESV(tmpsv);
-           gv_fullname(tmpsv,cGVOP->op_gv);
+           gv_fullname(tmpsv, cGVOP->op_gv, Nullch);
            dump("GV = %s\n", SvPV(tmpsv, na));
            LEAVE;
        }
@@ -309,10 +309,10 @@ register GV *gv;
     sv = sv_newmortal();
     dumplvl++;
     PerlIO_printf(Perl_debug_log, "{\n");
-    gv_fullname(sv,gv);
+    gv_fullname(sv, gv, Nullch);
     dump("GV_NAME = %s", SvPVX(sv));
     if (gv != GvEGV(gv)) {
-       gv_efullname(sv,GvEGV(gv));
+       gv_efullname(sv, GvEGV(gv), Nullch);
        dump("-> %s", SvPVX(sv));
     }
     dump("\n");

diff --git a/gv.c b/gv.c
index cb38bad..455e785 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -687,38 +687,32 @@ I32 sv_type;
 }
 
 void
-gv_fullname(sv,gv)
+gv_fullname(sv, gv, prefix)
 SV *sv;
 GV *gv;
+char *prefix;
 {
     HV *hv = GvSTASH(gv);
-
-    if (!hv)
+    if (!hv) {
+       SvOK_off(sv);
        return;
-    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
+    }
+    sv_setpv(sv, prefix ? prefix : "");
     sv_catpv(sv,HvNAME(hv));
     sv_catpvn(sv,"::", 2);
     sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
 }
 
 void
-gv_efullname(sv,gv)
+gv_efullname(sv, gv, prefix)
 SV *sv;
 GV *gv;
+char *prefix;
 {
-    GV* egv = GvEGV(gv);
-    HV *hv;
-    
+    GV *egv = GvEGV(gv);
     if (!egv)
        egv = gv;
-    hv = GvSTASH(egv);
-    if (!hv)
-       return;
-
-    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
-    sv_catpv(sv,HvNAME(hv));
-    sv_catpvn(sv,"::", 2);
-    sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
+    gv_fullname(sv, egv, prefix);
 }
 
 IO *

diff --git a/op.c b/op.c
index d008533..9ee7e29 100644 (file)
--- a/op.c
+++ b/op.c
@@ -49,7 +49,7 @@ CvNAME(cv)
 CV* cv;
 {
     SV* tmpsv = sv_newmortal();
-    gv_efullname(tmpsv, CvGV(cv));
+    gv_efullname(tmpsv, CvGV(cv), Nullch);
     return SvPV(tmpsv,na);
 }
 
@@ -2975,7 +2975,7 @@ OP *block;
        sv_catpv(sv,"-");
        sprintf(buf,"%ld",(long)curcop->cop_line);
        sv_catpv(sv,buf);
-       gv_efullname(tmpstr,gv);
+       gv_efullname(tmpstr, gv, Nullch);
        hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
     }
     op_free(op);

diff --git a/pp_ctl.c b/pp_ctl.c
index b48feb1..f533215 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -574,7 +574,7 @@ PP(pp_sort)
            if (!(cv && CvROOT(cv))) {
                if (gv) {
                    SV *tmpstr = sv_newmortal();
-                   gv_efullname(tmpstr, gv);
+                   gv_efullname(tmpstr, gv, Nullch);
                    if (cv && CvXSUB(cv))
                        DIE("Xsub \"%s\" called in sort", SvPVX(tmpstr));
                    DIE("Undefined sort subroutine \"%s\" called",
@@ -1114,7 +1114,7 @@ PP(pp_caller)
        RETURN;
     if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
        sv = NEWSV(49, 0);
-       gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv));
+       gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv), Nullch);
        PUSHs(sv_2mortal(sv));
        PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
     }
@@ -1623,7 +1623,7 @@ PP(pp_goto)
            if (!CvROOT(cv) && !CvXSUB(cv)) {
                if (CvGV(cv)) {
                    SV *tmpstr = sv_newmortal();
-                   gv_efullname(tmpstr, CvGV(cv));
+                   gv_efullname(tmpstr, CvGV(cv), Nullch);
                    DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
                }
                DIE("Goto undefined subroutine");
@@ -1760,12 +1760,13 @@ PP(pp_goto)
                        mark++;
                    }
                }
-               if (perldb && curstash != debstash) { /* &xsub is not copying @_ */
+               if (perldb && curstash != debstash) {
+                   /* &xsub is not copying @_ */
                    SV *sv = GvSV(DBsub);
                    save_item(sv);
-                   gv_efullname(sv, CvGV(cv)); /* We do not care about
-                                                * using sv to call CV,
-                                                * just for info. */
+                   gv_efullname(sv, CvGV(cv), Nullch);
+                   /* We do not care about using sv to call CV,
+                    * just for info. */
                }
                RETURNOP(CvSTART(cv));
            }

diff --git a/pp_sys.c b/pp_sys.c
index 0e44eee..9d962d0 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -748,7 +748,7 @@ PP(pp_select)
     else {
        GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
        if (gvp && *gvp == egv)
-           gv_efullname(TARG, defoutgv);
+           gv_efullname(TARG, defoutgv, Nullch);
        else
            sv_setsv(TARG, sv_2mortal(newRV((SV*)egv)));
        XPUSHTARG;
@@ -842,7 +842,7 @@ PP(pp_enterwrite)
     if (!cv) {
        if (fgv) {
            SV *tmpsv = sv_newmortal();
-           gv_efullname(tmpsv, gv);
+           gv_efullname(tmpsv, fgv, Nullch);
            DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
        }
        DIE("Not a format reference");
@@ -921,7 +921,7 @@ PP(pp_leavewrite)
        cv = GvFORM(fgv);
        if (!cv) {
            SV *tmpsv = sv_newmortal();
-           gv_efullname(tmpsv, fgv);
+           gv_efullname(tmpsv, fgv, Nullch);
            DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
        }
        return doform(cv,gv,op);
@@ -978,7 +978,7 @@ PP(pp_prtf)
        gv = defoutgv;
     if (!(io = GvIO(gv))) {
        if (dowarn) {
-           gv_fullname(sv,gv);
+           gv_fullname(sv, gv, Nullch);
            warn("Filehandle %s never opened", SvPV(sv,na));
        }
        SETERRNO(EBADF,RMS$_IFI);
@@ -986,7 +986,7 @@ PP(pp_prtf)
     }
     else if (!(fp = IoOFP(io))) {
        if (dowarn)  {
-           gv_fullname(sv,gv);
+           gv_fullname(sv, gv, Nullch);
            if (IoIFP(io))
                warn("Filehandle %s opened only for input", SvPV(sv,na));
            else

diff --git a/proto.h b/proto.h
index 92e51f6..df537e9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -125,12 +125,12 @@ GV*       gv_AVadd _((GV* gv));
 GV*    gv_HVadd _((GV* gv));
 GV*    gv_IOadd _((GV* gv));
 void   gv_check _((HV* stash));
-void   gv_efullname _((SV* sv, GV* gv));
+void   gv_efullname _((SV *sv, GV *gv, char *prefix));
 GV*    gv_fetchfile _((char* name));
 GV*    gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level));
 GV*    gv_fetchmethod _((HV* stash, char* name));
 GV*    gv_fetchpv _((char* name, I32 add, I32 sv_type));
-void   gv_fullname _((SV* sv, GV* gv));
+void   gv_fullname _((SV *sv, GV *gv, char *prefix));
 void   gv_init _((GV *gv, HV *stash, char *name, STRLEN len, int multi));
 HV*    gv_stashpv _((char* name, I32 create));
 HV*    gv_stashpvn _((char* name, U32 namelen, I32 create));

diff --git a/run.c b/run.c
index 697c7d2..5529fb6 100644 (file)
--- a/run.c
+++ b/run.c
@@ -71,7 +71,7 @@ OP *op;
     case OP_GV:
        if (cGVOP->op_gv) {
            sv = NEWSV(0,0);
-           gv_fullname(sv, cGVOP->op_gv);
+           gv_fullname(sv, cGVOP->op_gv, Nullch);
            PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na));
            SvREFCNT_dec(sv);
        }