add skipping of threads and threads::shared on default builds

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 886dd8c..2fb4b17 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -93,7 +93,7 @@ PP(pp_regcomp)
 
        /* Check against the last compiled regexp. */
        if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp ||
-           PM_GETRE(pm)->prelen != len ||
+           PM_GETRE(pm)->prelen != (I32)len ||
            memNE(PM_GETRE(pm)->precomp, t, len))
        {
            if (PM_GETRE(pm)) {
@@ -405,7 +405,7 @@ PP(pp_formline)
            itemsize = len;
            if (DO_UTF8(sv)) {
                itemsize = sv_len_utf8(sv);
-               if (itemsize != len) {
+               if (itemsize != (I32)len) {
                    I32 itembytes;
                    if (itemsize > fieldsize) {
                        itemsize = fieldsize;
@@ -447,7 +447,7 @@ PP(pp_formline)
            itemsize = len;
            if (DO_UTF8(sv)) {
                itemsize = sv_len_utf8(sv);
-               if (itemsize != len) {
+               if (itemsize != (I32)len) {
                    I32 itembytes;
                    if (itemsize <= fieldsize) {
                        send = chophere = s + itemsize;
@@ -1450,11 +1450,18 @@ PP(pp_caller)
     if (!MAXARG)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+       GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
        /* So is ccstack[dbcxix]. */
-       sv = NEWSV(49, 0);
-       gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
-       PUSHs(sv_2mortal(sv));
-       PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+       if (isGV(cvgv)) {
+           sv = NEWSV(49, 0);
+           gv_efullname3(sv, cvgv, Nullch);
+           PUSHs(sv_2mortal(sv));
+           PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+       }
+       else {
+           PUSHs(sv_2mortal(newSVpvn("(unknown)",9)));
+           PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+       }
     }
     else {
        PUSHs(sv_2mortal(newSVpvn("(eval)",6)));
@@ -1560,7 +1567,7 @@ PP(pp_dbstate)
        register CV *cv;
        register PERL_CONTEXT *cx;
        I32 gimme = G_ARRAY;
-       I32 hasargs;
+       U8 hasargs;
        GV *gv;
 
        gv = PL_DBgv;
@@ -2170,7 +2177,7 @@ PP(pp_goto)
                    cx->blk_sub.hasargs = 0;
                }
                cx->blk_sub.cv = cv;
-               cx->blk_sub.olddepth = CvDEPTH(cv);
+               cx->blk_sub.olddepth = (U16)CvDEPTH(cv);
                CvDEPTH(cv)++;
                if (CvDEPTH(cv) < 2)
                    (void)SvREFCNT_inc(cv);
@@ -2656,7 +2663,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     *avp = (AV*)SvREFCNT_inc(PL_comppad);
     LEAVE;
     if (PL_curcop == &PL_compiling)
-       PL_compiling.op_private = PL_hints;
+       PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
 #endif
@@ -2945,11 +2952,11 @@ PP(pp_require)
 
                /* help out with the "use 5.6" confusion */
                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".%03"UVuf"?)",
-                       rev, ver, sver, PERL_REVISION, PERL_VERSION,
-                       PERL_SUBVERSION, rev, ver/100);
+                   DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required"
+                       " (did you mean v%"UVuf".%03"UVuf"?)--"
+                       "this is only v%d.%d.%d, stopped",
+                       rev, ver, sver, rev, ver/100,
+                       PERL_REVISION, PERL_VERSION, PERL_SUBVERSION);
                }
                else {
                    DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--"
@@ -2976,6 +2983,17 @@ PP(pp_require)
        tryname = name;
        tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
     }
+#ifdef MACOS_TRADITIONAL
+    if (!tryrsfp) {
+       char newname[256];
+
+       MacPerl_CanonDir(name, newname, 1);
+       if (path_is_absolute(newname)) {
+           tryname = newname;
+           tryrsfp = doopen_pmc(newname,PERL_SCRIPT_MODE);
+       }
+    }
+#endif
     if (!tryrsfp) {
        AV *ar = GvAVn(PL_incgv);
        I32 i;
@@ -3109,8 +3127,11 @@ PP(pp_require)
                  ) {
                    char *dir = SvPVx(dirsv, n_a);
 #ifdef MACOS_TRADITIONAL
-                   char buf[256];
-                   Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf), name+(name[0] == ':'));
+                   char buf1[256];
+                   char buf2[256];
+
+                   MacPerl_CanonDir(name, buf2, 1);
+                   Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':'));
 #else
 #ifdef VMS
                    char *unixdir;
@@ -3124,14 +3145,6 @@ PP(pp_require)
 #endif
                    TAINT_PROPER("require");
                    tryname = SvPVX(namesv);
-#ifdef MACOS_TRADITIONAL
-                   {
-                       /* Convert slashes in the name part, but not the directory part, to colons */
-                       char * colon;
-                       for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); )
-                           *colon++ = ':';
-                   }
-#endif
                    tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
                    if (tryrsfp) {
                        if (tryname[0] == '.' && tryname[1] == '/')
@@ -3328,7 +3341,7 @@ PP(pp_entereval)
     MUTEX_UNLOCK(&PL_eval_mutex);
 #endif /* USE_5005THREADS */
     ret = doeval(gimme, NULL);
-    if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */
+    if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
        && ret != PL_op->op_next) {     /* Successive compilation. */
        strcpy(safestr, "_<(eval )");   /* Anything fake and short. */
     }
@@ -3526,14 +3539,14 @@ S_doparseform(pTHX_ SV *sv)
                if (postspace)
                    *fpc++ = FF_SPACE;
                *fpc++ = FF_LITERAL;
-               *fpc++ = arg;
+               *fpc++ = (U16)arg;
            }
            postspace = FALSE;
            if (s <= send)
                skipspaces--;
            if (skipspaces) {
                *fpc++ = FF_SKIP;
-               *fpc++ = skipspaces;
+               *fpc++ = (U16)skipspaces;
            }
            skipspaces = 0;
            if (s <= send)
@@ -3544,7 +3557,7 @@ S_doparseform(pTHX_ SV *sv)
                    arg = fpc - linepc + 1;
                else
                    arg = 0;
-               *fpc++ = arg;
+               *fpc++ = (U16)arg;
            }
            if (s < send) {
                linepc = fpc;
@@ -3567,7 +3580,7 @@ S_doparseform(pTHX_ SV *sv)
            arg = (s - base) - 1;
            if (arg) {
                *fpc++ = FF_LITERAL;
-               *fpc++ = arg;
+               *fpc++ = (U16)arg;
            }
 
            base = s - 1;
@@ -3592,7 +3605,7 @@ S_doparseform(pTHX_ SV *sv)
                }
                *fpc++ = s - base;              /* fieldsize for FETCH */
                *fpc++ = FF_DECIMAL;
-                *fpc++ = arg;
+                *fpc++ = (U16)arg;
             }
             else if (*s == '0' && s[1] == '#') {  /* Zero padded decimals */
                 arg = ischop ? 512 : 0;
@@ -3610,7 +3623,7 @@ S_doparseform(pTHX_ SV *sv)
                 }
                 *fpc++ = s - base;                /* fieldsize for FETCH */
                 *fpc++ = FF_0DECIMAL;
-               *fpc++ = arg;
+               *fpc++ = (U16)arg;
            }
            else {
                I32 prespace = 0;
@@ -3639,7 +3652,7 @@ S_doparseform(pTHX_ SV *sv)
                *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL;
 
                if (prespace)
-                   *fpc++ = prespace;
+                   *fpc++ = (U16)prespace;
                *fpc++ = FF_ITEM;
                if (ismore)
                    *fpc++ = FF_MORE;
@@ -3743,7 +3756,7 @@ S_path_is_absolute(pTHX_ char *name)
 {
     if (PERL_FILE_IS_ABSOLUTE(name)
 #ifdef MACOS_TRADITIONAL
-       || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
+       || (*name == ':'))
 #else
        || (*name == '.' && (name[1] == '/' ||
                             (name[1] == '.' && name[2] == '/'))))