AUTHORS update.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index a7ac731..567370b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -172,6 +172,7 @@ PP(pp_substcont)
     rxres_restore(&cx->sb_rxres, rx);
 
     if (cx->sb_iters++) {
+       I32 saviters = cx->sb_iters;
        if (cx->sb_iters > cx->sb_maxiters)
            DIE(aTHX_ "Substitution loop");
 
@@ -213,6 +214,7 @@ PP(pp_substcont)
            POPSUBST(cx);
            RETURNOP(pm->op_next);
        }
+       cx->sb_iters = saviters;
     }
     if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
        m = s;
@@ -1018,8 +1020,8 @@ PP(pp_sort)
                cx->blk_sub.oldcurpad = PL_curpad;
                cx->blk_sub.argarray = av;
            }
-           qsortsv((myorigmark+1), max,
-                   is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
+           sortsv((myorigmark+1), max,
+                  is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
 
            POPBLOCK(cx,PL_curpm);
            PL_stack_sp = newsp;
@@ -1030,8 +1032,8 @@ PP(pp_sort)
     else {
        if (max > 1) {
            MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
-           qsortsv(ORIGMARK+1, max,
-                   (PL_op->op_private & OPpSORT_NUMERIC)
+           sortsv(ORIGMARK+1, max,
+                  (PL_op->op_private & OPpSORT_NUMERIC)
                        ? ( (PL_op->op_private & OPpSORT_INTEGER)
                            ? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
                            : ( overloading ? amagic_ncmp : sv_ncmp))
@@ -1493,7 +1495,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 #endif
        PerlIO *serr = Perl_error_log;
 
-       PerlIO_write(serr, message, msglen);
+       PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
        (void)PerlIO_flush(serr);
 #ifdef USE_SFIO
        errno = e;
@@ -1779,7 +1781,7 @@ PP(pp_enteriter)
        SAVESPTR(*svp);
 #else
        SAVEPADSV(PL_op->op_targ);
-       iterdata = (void*)PL_op->op_targ;
+       iterdata = INT2PTR(void*, PL_op->op_targ);
        cxtype |= CXp_PADVAR;
 #endif
     }
@@ -2591,6 +2593,7 @@ PP(pp_exit)
 #ifdef VMS
         if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
            anum = 0;
+        VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
 #endif
     }
     PL_exit_flags |= PERL_EXIT_EXPECTED;
@@ -2894,8 +2897,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
     PL_error_count = 0;
     PL_curcop = &PL_compiling;
     PL_curcop->cop_arybase = 0;
-    SvREFCNT_dec(PL_rs);
-    PL_rs = newSVpvn("\n", 1);
     if (saveop && saveop->op_flags & OPf_SPECIAL)
        PL_in_eval |= EVAL_KEEPERR;
     else
@@ -2933,8 +2934,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
            Perl_croak(aTHX_ "%sCompilation failed in regexp",
                       (*msg ? msg : "Unknown error\n"));
        }
-       SvREFCNT_dec(PL_rs);
-       PL_rs = SvREFCNT_inc(PL_nrs);
 #ifdef USE_5005THREADS
        MUTEX_LOCK(&PL_eval_mutex);
        PL_eval_owner = 0;
@@ -2943,8 +2942,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
 #endif /* USE_5005THREADS */
        RETPUSHUNDEF;
     }
-    SvREFCNT_dec(PL_rs);
-    PL_rs = SvREFCNT_inc(PL_nrs);
     CopLINE_set(&PL_compiling, 0);
     if (startop) {
        *startop = PL_eval_root;
@@ -3038,6 +3035,7 @@ PP(pp_require)
     GV *filter_child_proc = 0;
     SV *filter_state = 0;
     SV *filter_sub = 0;
+    SV *hook_sv = 0;
 
     sv = POPs;
     if (SvNIOKp(sv)) {
@@ -3066,6 +3064,9 @@ PP(pp_require)
                    "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
                    PERL_VERSION, PERL_SUBVERSION);
            }
+           if (ckWARN(WARN_PORTABLE))
+               Perl_warner(aTHX_ WARN_PORTABLE,
+                        "v-string in use/require non-portable");
            RETPUSHYES;
        }
        else if (!SvPOKp(sv)) {                 /* require 5.005_03 */
@@ -3084,7 +3085,7 @@ PP(pp_require)
                if (sver == 0 && (rev > 5 || (rev == 5 && ver >= 100))) {
                    DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--"
                        "this is only v%d.%d.%d, stopped"
-                       " (did you mean v%"UVuf".%"UVuf".0?)",
+                       " (did you mean v%"UVuf".%03"UVuf"?)",
                        rev, ver, sver, PERL_REVISION, PERL_VERSION,
                        PERL_SUBVERSION, rev, ver/100);
                }
@@ -3236,6 +3237,7 @@ trylocal: {
                    LEAVE;
 
                    if (tryrsfp) {
+                       hook_sv = dirsv;
                        break;
                    }
 
@@ -3324,8 +3326,14 @@ trylocal: {
        SETERRNO(0, SS$_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
-    (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
-                  newSVpv(CopFILE(&PL_compiling), 0), 0 );
+    len = strlen(name);
+    /* Check whether a hook in @INC has already filled %INC */
+    if (!hook_sv || !(svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
+       (void)hv_store(GvHVn(PL_incgv), name, len,
+                      (hook_sv ? SvREFCNT_inc(hook_sv)
+                               : newSVpv(CopFILE(&PL_compiling), 0)),
+                      0 );
+    }
 
     ENTER;
     SAVETMPS;
@@ -4031,8 +4039,18 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp)
 ** They make convenient temporary pointers in other places.
 */
 
-STATIC void
-S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
+/* 
+=for apidoc sortsv
+   
+Sort an array. Here is an example:
+
+    sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); 
+
+=cut
+*/
+    
+void
+Perl_sortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
 {
     int i, run;
     int sense;