allow '*' prototype to autoquote even barewords that happen to be

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

diff --git a/pp_hot.c b/pp_hot.c
index 4c699ca..7709c53 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -204,19 +204,15 @@ PP(pp_readline)
 {
     tryAMAGICunTARGET(iter, 0);
     PL_last_in_gv = (GV*)(*PL_stack_sp--);
-    if (PL_op->op_flags & OPf_SPECIAL) {       /* Are called as <$var> */
-       if (SvROK(PL_last_in_gv)) {
-           if (SvTYPE(SvRV(PL_last_in_gv)) != SVt_PVGV) 
-               goto hard_way;
+    if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
+       if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV) 
            PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
-       } else if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
-         hard_way: {
+       else {
            dSP;
            XPUSHs((SV*)PL_last_in_gv);
            PUTBACK;
            pp_rv2gv(ARGS);
            PL_last_in_gv = (GV*)(*PL_stack_sp--);
-         }
        }
     }
     return do_readline();
@@ -237,7 +233,7 @@ PP(pp_preinc)
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
        croak(PL_no_modify);
-    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
     {
        ++SvIVX(TOPs);
@@ -733,16 +729,10 @@ PP(pp_aassign)
            }
            break;
        default:
-           if (SvTHINKFIRST(sv)) {
-               if (SvREADONLY(sv) && PL_curcop != &PL_compiling) {
-                   if (!SvIMMORTAL(sv))
-                       DIE(PL_no_modify);
-                   if (relem <= lastrelem)
-                       relem++;
-                   break;
-               }
-               if (SvROK(sv))
-                   sv_unref(sv);
+           if (SvIMMORTAL(sv)) {
+               if (relem <= lastrelem)
+                   relem++;
+               break;
            }
            if (relem <= lastrelem) {
                sv_setsv(sv, *relem);
@@ -1242,9 +1232,15 @@ do_readline(void)
                sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
                sv_catsv(tmpcmd, tmpglob);
 #else
+#ifdef CYGWIN32
+               sv_setpv(tmpcmd, "for a in ");
+               sv_catsv(tmpcmd, tmpglob);
+               sv_catpv(tmpcmd, "; do echo -e \"$a\\0\\c\"; done |");
+#else
                sv_setpv(tmpcmd, "perlglob ");
                sv_catsv(tmpcmd, tmpglob);
                sv_catpv(tmpcmd, " |");
+#endif /* !CYGWIN */
 #endif /* !DJGPP */
 #endif /* !OS2 */
 #else /* !DOSISH */
@@ -1274,9 +1270,14 @@ do_readline(void)
            SP--;
     }
     if (!fp) {
-       if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START))
-           warner(WARN_CLOSED,
-                  "Read on closed filehandle <%s>", GvENAME(PL_last_in_gv));
+       if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+           if (type == OP_GLOB)
+               warner(WARN_CLOSED, "glob failed (can't start child: %s)",
+                      Strerror(errno));
+           else
+               warner(WARN_CLOSED, "Read on closed filehandle <%s>",
+                      GvENAME(PL_last_in_gv));
+       }
        if (gimme == G_SCALAR) {
            (void)SvOK_off(TARG);
            PUSHTARG;
@@ -2098,7 +2099,12 @@ PP(pp_entersub)
        break;
     case SVt_PVGV:
        if (!(cv = GvCVu((GV*)sv)))
-           cv = sv_2cv(sv, &stash, &gv, TRUE);
+           cv = sv_2cv(sv, &stash, &gv, FALSE);
+       if (!cv) {
+           ENTER;
+           SAVETMPS;
+           goto try_autoload;
+       }
        break;
     }
 
@@ -2106,9 +2112,6 @@ PP(pp_entersub)
     SAVETMPS;
 
   retry:
-    if (!cv)
-       DIE("Not a CODE reference");
-
     if (!CvROOT(cv) && !CvXSUB(cv)) {
        GV* autogv;
        SV* sub_name;
@@ -2116,29 +2119,37 @@ PP(pp_entersub)
        /* anonymous or undef'd function leaves us no recourse */
        if (CvANON(cv) || !(gv = CvGV(cv)))
            DIE("Undefined subroutine called");
+
        /* autoloaded stub? */
        if (cv != GvCV(gv)) {
            cv = GvCV(gv);
-           goto retry;
        }
        /* should call AUTOLOAD now? */
-       if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+       else {
+try_autoload:
+           if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
                                   FALSE)))
-       {
-           cv = GvCV(autogv);
-           goto retry;
+           {
+               cv = GvCV(autogv);
+           }
+           /* sorry */
+           else {
+               sub_name = sv_newmortal();
+               gv_efullname3(sub_name, gv, Nullch);
+               DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+           }
        }
-       /* sorry */
-       sub_name = sv_newmortal();
-       gv_efullname3(sub_name, gv, Nullch);
-       DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+       if (!cv)
+           DIE("Not a CODE reference");
+       goto retry;
     }
 
     gimme = GIMME_V;
-    if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv))
+    if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
        cv = get_db_sub(&sv, cv);
-    if (!cv)
-       DIE("No DBsub routine");
+       if (!cv)
+           DIE("No DBsub routine");
+    }
 
 #ifdef USE_THREADS
     /*
@@ -2155,8 +2166,13 @@ PP(pp_entersub)
            if (SP > PL_stack_base + TOPMARK)
                sv = *(PL_stack_base + TOPMARK + 1);
            else {
-               MUTEX_UNLOCK(CvMUTEXP(cv));
-               croak("no argument for locked method call");
+               AV *av = (AV*)PL_curpad[0];
+               if (hasargs || !av || AvFILLp(av) < 0
+                   || !(sv = AvARRAY(av)[0]))
+               {
+                   MUTEX_UNLOCK(CvMUTEXP(cv));
+                   croak("no argument for locked method call");
+               }
            }
            if (SvROK(sv))
                sv = SvRV(sv);
@@ -2269,6 +2285,7 @@ PP(pp_entersub)
 #endif /* USE_THREADS */
 
     if (CvXSUB(cv)) {
+#ifdef PERL_XSUB_OLDSTYLE
        if (CvOLDSTYLE(cv)) {
            I32 (*fp3)_((int,int,int));
            dMARK;
@@ -2285,7 +2302,9 @@ PP(pp_entersub)
                           items);
            PL_stack_sp = PL_stack_base + items;
        }
-       else {
+       else
+#endif /* PERL_XSUB_OLDSTYLE */
+       {
            I32 markix = TOPMARK;
 
            PUTBACK;
@@ -2311,9 +2330,8 @@ PP(pp_entersub)
                    PUTBACK ;               
                }
            }
-           if (PL_curcopdb) {          /* We assume that the first
-                                          XSUB in &DB::sub is the
-                                          called one. */
+           /* We assume first XSUB in &DB::sub is the called one. */
+           if (PL_curcopdb) {
                SAVESPTR(PL_curcop);
                PL_curcop = PL_curcopdb;
                PL_curcopdb = NULL;