Let SvRX(OK) recognise a bare REGEXP.

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 976cfe3..a85966b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -353,10 +353,9 @@ S_del_sv(pTHX_ SV *p)
            }
        }
        if (!ok) {
-           if (ckWARN_d(WARN_INTERNAL))        
-               Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                           "Attempt to free non-arena SV: 0x%"UVxf
-                            pTHX__FORMAT, PTR2UV(p) pTHX__VALUE);
+           Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+                            "Attempt to free non-arena SV: 0x%"UVxf
+                            pTHX__FORMAT, PTR2UV(p) pTHX__VALUE);
            return;
        }
     }
@@ -3892,7 +3891,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        }
        /* Fall through */
 #endif
-    case SVt_REGEXP:
     case SVt_PV:
        if (dtype < SVt_PV)
            sv_upgrade(dstr, SVt_PV);
@@ -3915,6 +3913,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        }
        break;
 
+    case SVt_REGEXP:
+       if (dtype < SVt_REGEXP)
+           sv_upgrade(dstr, SVt_REGEXP);
+       break;
+
        /* case SVt_BIND: */
     case SVt_PVLV:
     case SVt_PVGV:
@@ -4005,9 +4008,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     }
     else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
        if (!(sflags & SVf_OK)) {
-           if (ckWARN(WARN_MISC))
-               Perl_warner(aTHX_ packWARN(WARN_MISC),
-                           "Undefined value assigned to typeglob");
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                          "Undefined value assigned to typeglob");
        }
        else {
            GV *gv = gv_fetchsv(sstr, GV_ADD, SVt_PVGV);
@@ -4018,6 +4020,9 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
            }
        }
     }
+    else if (dtype == SVt_REGEXP && stype == SVt_REGEXP) {
+       reg_temp_copy((REGEXP*)dstr, (REGEXP*)sstr);
+    }
     else if (sflags & SVp_POK) {
         bool isSwipe = 0;
 
@@ -5239,8 +5244,7 @@ Perl_sv_rvweaken(pTHX_ SV *const sv)
     if (!SvROK(sv))
        Perl_croak(aTHX_ "Can't weaken a nonreference");
     else if (SvWEAKREF(sv)) {
-       if (ckWARN(WARN_MISC))
-           Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
+       Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
        return sv;
     }
     tsv = SvRV(sv);
@@ -5918,10 +5922,9 @@ Perl_sv_free2(pTHX_ SV *const sv)
 
 #ifdef DEBUGGING
     if (SvTEMP(sv)) {
-       if (ckWARN_d(WARN_DEBUGGING))
-           Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
-                       "Attempt to free temp prematurely: SV 0x%"UVxf
-                        pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING),
+                        "Attempt to free temp prematurely: SV 0x%"UVxf
+                        pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
        return;
     }
 #endif
@@ -7284,10 +7287,10 @@ Perl_sv_inc(pTHX_ register SV *const sv)
     if (flags & SVp_NOK) {
        const NV was = SvNVX(sv);
        if (NV_OVERFLOWS_INTEGERS_AT &&
-           was >= NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
-           Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
-                       "Lost precision when incrementing %" NVff " by 1",
-                       was);
+           was >= NV_OVERFLOWS_INTEGERS_AT) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
+                          "Lost precision when incrementing %" NVff " by 1",
+                          was);
        }
        (void)SvNOK_only(sv);
         SvNV_set(sv, was + 1.0);
@@ -7450,10 +7453,10 @@ Perl_sv_dec(pTHX_ register SV *const sv)
        {
            const NV was = SvNVX(sv);
            if (NV_OVERFLOWS_INTEGERS_AT &&
-               was <= -NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
-               Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
-                           "Lost precision when decrementing %" NVff " by 1",
-                           was);
+               was <= -NV_OVERFLOWS_INTEGERS_AT) {
+               Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
+                              "Lost precision when decrementing %" NVff " by 1",
+                              was);
            }
            (void)SvNOK_only(sv);
            SvNV_set(sv, was - 1.0);
@@ -7998,8 +8001,7 @@ Perl_newSVsv(pTHX_ register SV *const old)
     if (!old)
        return NULL;
     if (SvTYPE(old) == SVTYPEMASK) {
-        if (ckWARN_d(WARN_INTERNAL))
-           Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
        return NULL;
     }
     new_SV(sv);
@@ -9444,9 +9446,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
                    goto string;
                }
                else if (n) {
-                   if (ckWARN_d(WARN_INTERNAL))
-                       Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                       "internal %%<num>p might conflict with future printf extensions");
+                   Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+                                    "internal %%<num>p might conflict with future printf extensions");
                }
            }
            q = r; 
@@ -12261,8 +12262,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_tmps_max             = proto_perl->Itmps_max;
        PL_tmps_floor           = proto_perl->Itmps_floor;
        Newx(PL_tmps_stack, PL_tmps_max, SV*);
-       sv_dup_inc_multiple(proto_perl->Itmps_stack, PL_tmps_stack, PL_tmps_ix,
-                           param);
+       sv_dup_inc_multiple(proto_perl->Itmps_stack, PL_tmps_stack,
+                           PL_tmps_ix+1, param);
 
        /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
        i = proto_perl->Imarkstack_max - proto_perl->Imarkstack;