Refactor S_glob_2inpuv

Message-ID: <20060424021239.GA5449@petdance.com>

p4raw-id: //depot/perl@27942

diff --git a/embed.fnc b/embed.fnc
index 37c4446..ad86015 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -756,7 +756,8 @@ Apd |bool   |sv_2bool       |NN SV* sv
 Apd    |CV*    |sv_2cv         |NULLOK SV* sv|NN HV** st|NN GV** gvp|I32 lref
 Apd    |IO*    |sv_2io         |NN SV* sv
 #ifdef PERL_IN_SV_C
-s      |char*  |glob_2inpuv    |NN GV* gv|NULLOK STRLEN *len|bool want_number
+s      |char*  |glob_2inpuv_number|NN GV* const gv
+s      |char*  |glob_2inpuv    |NN GV* const gv|NN STRLEN * const len
 #endif
 Amb    |IV     |sv_2iv         |NN SV* sv
 Apd    |IV     |sv_2iv_flags   |NN SV* sv|I32 flags

diff --git a/embed.h b/embed.h
index 92b68a2..afaae7f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -793,6 +793,7 @@
 #define sv_2io                 Perl_sv_2io
 #ifdef PERL_IN_SV_C
 #ifdef PERL_CORE
+#define glob_2inpuv_number     S_glob_2inpuv_number
 #define glob_2inpuv            S_glob_2inpuv
 #endif
 #endif
@@ -2953,7 +2954,8 @@
 #define sv_2io(a)              Perl_sv_2io(aTHX_ a)
 #ifdef PERL_IN_SV_C
 #ifdef PERL_CORE
-#define glob_2inpuv(a,b,c)     S_glob_2inpuv(aTHX_ a,b,c)
+#define glob_2inpuv_number(a)  S_glob_2inpuv_number(aTHX_ a)
+#define glob_2inpuv(a,b)       S_glob_2inpuv(aTHX_ a,b)
 #endif
 #endif
 #define sv_2iv_flags(a,b)      Perl_sv_2iv_flags(aTHX_ a,b)

diff --git a/proto.h b/proto.h
index fa6de13..79c367f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2064,9 +2064,13 @@ PERL_CALLCONV IO*        Perl_sv_2io(pTHX_ SV* sv)
                        __attribute__nonnull__(pTHX_1);
 
 #ifdef PERL_IN_SV_C
-STATIC char*   S_glob_2inpuv(pTHX_ GV* gv, STRLEN *len, bool want_number)
+STATIC char*   S_glob_2inpuv_number(pTHX_ GV* const gv)
                        __attribute__nonnull__(pTHX_1);
 
+STATIC char*   S_glob_2inpuv(pTHX_ GV* const gv, STRLEN * const len)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+
 #endif
 /* PERL_CALLCONV IV    sv_2iv(pTHX_ SV* sv)
                        __attribute__nonnull__(pTHX_1); */

diff --git a/sv.c b/sv.c
index 1c2e0af..598b593 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1718,7 +1718,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
 }
 
 STATIC char *
-S_glob_2inpuv(pTHX_ GV *gv, STRLEN *len, bool want_number)
+S_glob_2inpuv_number(pTHX_ GV * const gv)
 {
     const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
     SV *const buffer = sv_newmortal();
@@ -1729,21 +1729,30 @@ S_glob_2inpuv(pTHX_ GV *gv, STRLEN *len, bool want_number)
     gv_efullname3(buffer, gv, "*");
     SvFLAGS(gv) |= wasfake;
 
-    if (want_number) {
-       /* We know that all GVs stringify to something that is not-a-number,
-          so no need to test that.  */
-       if (ckWARN(WARN_NUMERIC))
-           not_a_number(buffer);
-       /* We just want something true to return, so that S_sv_2iuv_common
-          can tail call us and return true.  */
-       return (char *) 1;
-    } else {
-       assert(SvPOK(buffer));
-       if (len) {
-           *len = SvCUR(buffer);
-       }
-       return SvPVX(buffer);
-    }
+    /* We know that all GVs stringify to something that is not-a-number,
+       so no need to test that.  */
+    if (ckWARN(WARN_NUMERIC))
+       not_a_number(buffer);
+    /* We just want something true to return, so that S_sv_2iuv_common
+       can tail call us and return true.  */
+    return (char *) 1;
+}
+
+STATIC char *
+S_glob_2inpuv(pTHX_ GV * const gv, STRLEN * const len)
+{
+    const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
+    SV *const buffer = sv_newmortal();
+
+    /* FAKE globs can get coerced, so need to turn this off temporarily if it
+       is on.  */
+    SvFAKE_off(gv);
+    gv_efullname3(buffer, gv, "*");
+    SvFLAGS(gv) |= wasfake;
+
+    assert(SvPOK(buffer));
+    *len = SvCUR(buffer);
+    return SvPVX(buffer);
 }
 
 /* Actually, ISO C leaves conversion of UV to IV undefined, but
@@ -2113,9 +2122,8 @@ S_sv_2iuv_common(pTHX_ SV *sv) {
        }
     }
     else  {
-       if (isGV_with_GP(sv)) {
-           return (bool)PTR2IV(glob_2inpuv((GV *)sv, NULL, TRUE));
-       }
+       if (isGV_with_GP(sv))
+           return (bool)PTR2IV(glob_2inpuv_number((GV *)sv));
 
        if (!(SvFLAGS(sv) & SVs_PADTMP)) {
            if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
@@ -2465,7 +2473,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     }
     else  {
        if (isGV_with_GP(sv)) {
-           glob_2inpuv((GV *)sv, NULL, TRUE);
+           glob_2inpuv_number((GV *)sv);
            return 0.0;
        }
 
@@ -2801,9 +2809,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 #endif
     }
     else {
-       if (isGV_with_GP(sv)) {
-           return glob_2inpuv((GV *)sv, lp, FALSE);
-       }
+       if (isGV_with_GP(sv))
+           return glob_2inpuv((GV *)sv, lp);
 
        if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);