This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change 27947 forgot to remove one now-unneeded cast.
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index e9f47dd..899df93 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1717,8 +1717,29 @@ Perl_looks_like_number(pTHX_ SV *sv)
     return grok_number(sbegin, len, NULL);
 }
 
+STATIC bool
+S_glob_2number(pTHX_ GV * const gv)
+{
+    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;
+
+    /* 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 TRUE;
+}
+
 STATIC char *
-S_glob_2inpuv(pTHX_ GV *gv, STRLEN *len, bool want_number)
+S_glob_2pv(pTHX_ GV * const gv, STRLEN * const len)
 {
     const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
     SV *const buffer = sv_newmortal();
@@ -1729,21 +1750,9 @@ 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);
-    }
+    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 glob_2number((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_2number((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_2pv((GV *)sv, lp);
 
        if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
@@ -3309,8 +3316,9 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
                        }
                    }
                if (!intro)
-                   cv_ckproto(cv, (GV*)dstr,
-                              SvPOK(sref) ? SvPVX_const(sref) : NULL);
+                   cv_ckproto_len(cv, (GV*)dstr,
+                                  SvPOK(sref) ? SvPVX_const(sref) : NULL,
+                                  SvPOK(sref) ? SvCUR(sref) : 0);
            }
            GvCVGEN(dstr) = 0; /* Switch off cacheness. */
            GvASSUMECV_on(dstr);
@@ -3898,7 +3906,7 @@ that pointer (e.g. ptr + 1) be used.
 
 If C<flags> & SV_SMAGIC is true, will call SvSETMAGIC. If C<flags> &
 SV_HAS_TRAILING_NUL is true, then C<ptr[len]> must be NUL, and the realloc
-I<may> be skipped. (i.e. the buffer is actually at least 1 byte longer than
+will be skipped. (i.e. the buffer is actually at least 1 byte longer than
 C<len>, and already meets the requirements for storing in C<SvPVX>)
 
 =cut
@@ -3925,20 +3933,21 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
 
     allocate = (flags & SV_HAS_TRAILING_NUL)
        ? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
+    if (flags & SV_HAS_TRAILING_NUL) {
+       /* It's long enough - do nothing.
+          Specfically Perl_newCONSTSUB is relying on this.  */
+    } else {
 #ifdef DEBUGGING
-    {
        /* Force a move to shake out bugs in callers.  */
        char *new_ptr = safemalloc(allocate);
        Copy(ptr, new_ptr, len, char);
        PoisonFree(ptr,len,char);
        Safefree(ptr);
        ptr = new_ptr;
-    }
 #else
-    if (!(flags & SV_HAS_TRAILING_NUL)) {
        ptr = saferealloc (ptr, allocate);
-    }
 #endif
+    }
     SvPV_set(sv, ptr);
     SvCUR_set(sv, len);
     SvLEN_set(sv, allocate);
@@ -10687,10 +10696,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                    = pv_dup(old_state->re_state_reg_oldsaved);
                new_state->re_state_reg_poscache
                    = pv_dup(old_state->re_state_reg_poscache);
-#ifdef DEBUGGING
                new_state->re_state_reg_starttry
                    = pv_dup(old_state->re_state_reg_starttry);
-#endif
                break;
            }
        case SAVEt_COMPILE_WARNINGS:
@@ -11887,7 +11894,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                subscript_type = FUV_SUBSCRIPT_HASH;
        }
        else {
-           index = S_find_array_subscript(aTHX_ (AV*)sv, uninit_sv);
+           index = find_array_subscript((AV*)sv, uninit_sv);
            if (index >= 0)
                subscript_type = FUV_SUBSCRIPT_ARRAY;
        }
@@ -12101,13 +12108,14 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
         * or are optimized away, then it's unambiguous */
        o2 = NULL;
        for (kid=o; kid; kid = kid->op_sibling) {
-           if (kid &&
-               (    (kid->op_type == OP_CONST && SvOK(cSVOPx_sv(kid)))
-                 || (kid->op_type == OP_NULL  && ! (kid->op_flags & OPf_KIDS))
-                 || (kid->op_type == OP_PUSHMARK)
+           if (kid) {
+               const OPCODE type = kid->op_type;
+               if ( (type == OP_CONST && SvOK(cSVOPx_sv(kid)))
+                 || (type == OP_NULL  && ! (kid->op_flags & OPf_KIDS))
+                 || (type == OP_PUSHMARK)
                )
-           )
                continue;
+           }
            if (o2) { /* more than one found */
                o2 = NULL;
                break;