blead 25801: Symbian batch of today

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

diff --git a/pp_ctl.c b/pp_ctl.c
index f817720..fd1bccd 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -122,7 +122,7 @@ PP(pp_regcomp)
            mg = mg_find(sv, PERL_MAGIC_qr);
     }
     if (mg) {
-       regexp *re = (regexp *)mg->mg_obj;
+       regexp * const re = (regexp *)mg->mg_obj;
        ReREFCNT_dec(PM_GETRE(pm));
        PM_SETRE(pm, ReREFCNT_inc(re));
     }
@@ -222,7 +222,7 @@ PP(pp_substcont)
                                      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
                                      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
        {
-           SV *targ = cx->sb_targ;
+           SV * const targ = cx->sb_targ;
 
            assert(cx->sb_strend >= s);
            if(cx->sb_strend > s) {
@@ -280,7 +280,7 @@ PP(pp_substcont)
     }
     cx->sb_s = rx->endp[0] + orig;
     { /* Update the pos() information. */
-       SV *sv = cx->sb_targ;
+       SV * const sv = cx->sb_targ;
        MAGIC *mg;
        I32 i;
        if (SvTYPE(sv) < SVt_PVMG)
@@ -368,7 +368,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 void
 Perl_rxres_free(pTHX_ void **rsp)
 {
-    UV *p = (UV*)*rsp;
+    UV * const p = (UV*)*rsp;
 
     if (p) {
 #ifdef PERL_POISON
@@ -392,7 +392,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
-    register SV *tmpForm = *++MARK;
+    register SV * const tmpForm = *++MARK;
     register U32 *fpc;
     register char *t;
     const char *f;
@@ -408,7 +408,7 @@ PP(pp_formline)
     NV value;
     bool gotsome = FALSE;
     STRLEN len;
-    STRLEN fudge = SvPOK(tmpForm)
+    const STRLEN fudge = SvPOK(tmpForm)
                        ? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
@@ -1075,7 +1075,7 @@ PP(pp_flip)
     }
     else {
        dTOPss;
-       SV *targ = PAD_SV(PL_op->op_targ);
+       SV * const targ = PAD_SV(PL_op->op_targ);
        int flip = 0;
 
        if (PL_op->op_private & OPpFLIP_LINENUM) {
@@ -1083,8 +1083,9 @@ PP(pp_flip)
                flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
            }
            else {
-               GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
-               if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv));
+               GV * const gv = gv_fetchpv(".", TRUE, SVt_PV);
+               if (gv && GvSV(gv))
+                   flip = SvIV(sv) == SvIV(GvSV(gv));
            }
        } else {
            flip = SvTRUE(sv);
@@ -1150,9 +1151,9 @@ PP(pp_flop)
            }
        }
        else {
-           SV *final = sv_mortalcopy(right);
+           SV * const final = sv_mortalcopy(right);
            STRLEN len;
-           const char *tmps = SvPV_const(final, len);
+           const char * const tmps = SvPV_const(final, len);
 
            SV *sv = sv_mortalcopy(left);
            SvPV_force_nolen(sv);
@@ -1470,7 +1471,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
            PL_curcop = cx->blk_oldcop;
 
            if (optype == OP_REQUIRE) {
-                const char* msg = SvPVx_nolen_const(ERRSV);
+                const char* const msg = SvPVx_nolen_const(ERRSV);
                SV * const nsv = cx->blk_eval.old_namesv;
                 (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                                &PL_sv_undef, 0);
@@ -3093,7 +3094,6 @@ PP(pp_require)
     STRLEN len;
     const char *tryname = Nullch;
     SV *namesv = Nullsv;
-    SV** svp;
     const I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
     int filter_has_file = 0;
@@ -3130,12 +3130,14 @@ PP(pp_require)
     if (!(name && len > 0 && *name))
        DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
-    if (PL_op->op_type == OP_REQUIRE &&
-       (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
-       if (*svp != &PL_sv_undef)
-           RETPUSHYES;
-       else
-           DIE(aTHX_ "Compilation failed in require");
+    if (PL_op->op_type == OP_REQUIRE) {
+       SV ** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+       if ( svp ) {
+           if (*svp != &PL_sv_undef)
+               RETPUSHYES;
+           else
+               DIE(aTHX_ "Compilation failed in require");
+       }
     }
 
     /* prepare to compile file */
@@ -3156,7 +3158,7 @@ PP(pp_require)
     }
 #endif
     if (!tryrsfp) {
-       AV *ar = GvAVn(PL_incgv);
+       AV * const ar = GvAVn(PL_incgv);
        I32 i;
 #ifdef VMS
        char *unixname;
@@ -3302,7 +3304,7 @@ PP(pp_require)
                    sv_setpv(namesv, unixdir);
                    sv_catpv(namesv, unixname);
 #  else
-#    ifdef SYMBIAN
+#    ifdef __SYMBIAN32__
                    if (PL_origfilename[0] &&
                        PL_origfilename[1] == ':' &&
                        !(dir[0] && dir[1] == ':'))
@@ -3338,25 +3340,32 @@ PP(pp_require)
     if (!tryrsfp) {
        if (PL_op->op_type == OP_REQUIRE) {
            const char *msgstr = name;
-           if (namesv) {                       /* did we lookup @INC? */
-               SV *msg = sv_2mortal(newSVpv(msgstr,0));
-               SV *dirmsgsv = NEWSV(0, 0);
-               AV *ar = GvAVn(PL_incgv);
-               I32 i;
-               sv_catpvn(msg, " in @INC", 8);
-               if (instr(SvPVX_const(msg), ".h "))
-                   sv_catpv(msg, " (change .h to .ph maybe?)");
-               if (instr(SvPVX_const(msg), ".ph "))
-                   sv_catpv(msg, " (did you run h2ph?)");
-               sv_catpv(msg, " (@INC contains:");
-               for (i = 0; i <= AvFILL(ar); i++) {
-                   const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
-                   Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
-                   sv_catsv(msg, dirmsgsv);
-               }
-               sv_catpvn(msg, ")", 1);
-               SvREFCNT_dec(dirmsgsv);
+           if(errno == EMFILE) {
+               SV * const msg = sv_2mortal(newSVpv(msgstr,0));
+               sv_catpv(msg, ":  "); 
+               sv_catpv(msg, Strerror(errno));
                msgstr = SvPV_nolen_const(msg);
+           } else {
+               if (namesv) {                   /* did we lookup @INC? */
+                   SV * const msg = sv_2mortal(newSVpv(msgstr,0));
+                   SV * const dirmsgsv = NEWSV(0, 0);
+                   AV * const ar = GvAVn(PL_incgv);
+                   I32 i;
+                   sv_catpvn(msg, " in @INC", 8);
+                   if (instr(SvPVX_const(msg), ".h "))
+                       sv_catpv(msg, " (change .h to .ph maybe?)");
+                   if (instr(SvPVX_const(msg), ".ph "))
+                       sv_catpv(msg, " (did you run h2ph?)");
+                   sv_catpv(msg, " (@INC contains:");
+                   for (i = 0; i <= AvFILL(ar); i++) {
+                       const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
+                       Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
+                       sv_catsv(msg, dirmsgsv);
+                   }
+                   sv_catpvn(msg, ")", 1);
+                   SvREFCNT_dec(dirmsgsv);
+                   msgstr = SvPV_nolen_const(msg);
+               }    
            }
            DIE(aTHX_ "Can't locate %s", msgstr);
        }
@@ -3369,11 +3378,12 @@ PP(pp_require)
     /* Assume success here to prevent recursive requirement. */
     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 );
+    if (!hook_sv) {
+       (void)hv_store(GvHVn(PL_incgv), name, len, newSVpv(CopFILE(&PL_compiling),0),0);
+    } else {
+       SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+       if (!svp)
+           (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc(hook_sv), 0 );
     }
 
     ENTER;