Upgrade to ExtUtils-MakeMaker-6.50

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

diff --git a/pp_ctl.c b/pp_ctl.c
index a3b0b0f..f512832 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -511,8 +511,7 @@ PP(pp_formline)
            if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
                SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
                *t = '\0';
-               sv_utf8_upgrade(PL_formtarget);
-               SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+               sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC, fudge + 1);
                t = SvEND(PL_formtarget);
                targ_is_utf8 = TRUE;
            }
@@ -695,8 +694,8 @@ PP(pp_formline)
                    if (!targ_is_utf8) {
                        SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
                        *t = '\0';
-                       sv_utf8_upgrade(PL_formtarget);
-                       SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+                       sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC,
+                                                                   fudge + 1);
                        t = SvEND(PL_formtarget);
                        targ_is_utf8 = TRUE;
                    }
@@ -807,7 +806,7 @@ PP(pp_formline)
                                      t - SvPVX_const(PL_formtarget));
                            targ_is_utf8 = TRUE;
                            /* Don't need get magic.  */
-                           sv_utf8_upgrade_flags(PL_formtarget, 0);
+                           sv_utf8_upgrade_nomg(PL_formtarget);
                        } else {
                            SvCUR_set(PL_formtarget,
                                      t - SvPVX_const(PL_formtarget));
@@ -1779,7 +1778,7 @@ PP(pp_caller)
            /* Get the bit mask for $warnings::Bits{all}, because
             * it could have been extended by warnings::register */
            SV **bits_all;
-           HV * const bits = get_hv("warnings::Bits", FALSE);
+           HV * const bits = get_hv("warnings::Bits", 0);
            if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
                mask = newSVsv(*bits_all);
            }
@@ -2576,7 +2575,7 @@ PP(pp_goto)
                if (PERLDB_SUB) {       /* Checking curstash breaks DProf. */
                    Perl_get_db_sub(aTHX_ NULL, cv);
                    if (PERLDB_GOTO) {
-                       CV * const gotocv = get_cv("DB::goto", FALSE);
+                       CV * const gotocv = get_cvs("DB::goto", 0);
                        if (gotocv) {
                            PUSHMARK( PL_stack_sp );
                            call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG);
@@ -3048,7 +3047,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
            POPEVAL(cx);
        }
        lex_end();
-       LEAVE;
+       LEAVE; /* pp_entereval knows about this LEAVE.  */
 
        msg = SvPVx_nolen_const(ERRSV);
        if (optype == OP_REQUIRE) {
@@ -3099,7 +3098,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 
     /* Register with debugger: */
     if (PERLDB_INTER && saveop && saveop->op_type == OP_REQUIRE) {
-       CV * const cv = get_cv("DB::postponed", FALSE);
+       CV * const cv = get_cvs("DB::postponed", 0);
        if (cv) {
            dSP;
            PUSHMARK(SP);
@@ -3656,9 +3655,7 @@ PP(pp_entereval)
     const U32 was = PL_breakable_sub_gen;
     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
-    char *safestr;
     STRLEN len;
-    bool ok;
     CV* runcv;
     U32 seq;
     HV *saved_hh = NULL;
@@ -3696,8 +3693,6 @@ PP(pp_entereval)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
-    safestr = savepvn(tmpbuf, len);
-    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     if (saved_hh)
@@ -3729,20 +3724,29 @@ PP(pp_entereval)
     if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
-    ok = doeval(gimme, NULL, runcv, seq);
-    if (ok ? (was != PL_breakable_sub_gen /* Some subs defined here. */
-             ? (PERLDB_LINE || PERLDB_SAVESRC)
-             :  PERLDB_SAVESRC_NOSUBS)
-       : PERLDB_SAVESRC_INVALID) {
-       /* Just need to change the string in our writable scratch buffer that
-          will be used at scope exit to delete this eval's "file" name, to
-          something safe. The key names are of the form "_<(eval 1)" upwards,
-          so the 8th char is the first digit, which will not have a leading
-          zero. So give it a leading zero, and it can't match anything, but
-          still sits within the pattern space "reserved" for evals.  */
-       safestr[8] = '0';
-    }
-    return ok ? DOCATCH(PL_eval_start) : PL_op->op_next;
+
+    if (doeval(gimme, NULL, runcv, seq)) {
+       if (was != PL_breakable_sub_gen /* Some subs defined here. */
+           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           :  PERLDB_SAVESRC_NOSUBS) {
+           /* Retain the filegv we created.  */
+       } else {
+           char *const safestr = savepvn(tmpbuf, len);
+           SAVEDELETE(PL_defstash, safestr, len);
+       }
+       return DOCATCH(PL_eval_start);
+    } else {
+       /* We have already left the scope set up earler thanks to the LEAVE
+          in doeval().  */
+       if (was != PL_breakable_sub_gen /* Some subs defined here. */
+           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           :  PERLDB_SAVESRC_INVALID) {
+           /* Retain the filegv we created.  */
+       } else {
+           (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD);
+       }
+       return PL_op->op_next;
+    }
 }
 
 PP(pp_leaveeval)
@@ -4083,8 +4087,12 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     if (SvGMAGICAL(e))
        e = sv_mortalcopy(e);
 
-    if (SM_OBJECT)
-       Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+    if (SM_OBJECT) {
+       if (!SvOK(d) || !SvOK(e))
+           RETPUSHNO;
+       else
+           Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+    }
 
     if (SM_CV_NEP) {
        I32 c;