Add Time::Piece, a slight rewrite of Time::Object,

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

diff --git a/pp.c b/pp.c
index 37ada8b..6730f29 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -448,10 +448,12 @@ PP(pp_prototype)
                    else if (n && str[0] == ';' && seen_question)
                        goto set;       /* XXXX system, exec */
                    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
-                       && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+                       && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
+                       /* But globs are already references (kinda) */
+                       && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
+                   ) {
                        str[n++] = '\\';
                    }
-                   /* What to do with R ((un)tie, tied, (sys)read, recv)? */
                    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
                    oa = oa >> 4;
                }
@@ -1232,6 +1234,16 @@ PP(pp_repeat)
            (void)SvPOK_only_UTF8(TARG);
        else
            (void)SvPOK_only(TARG);
+
+       if (PL_op->op_private & OPpREPEAT_DOLIST) {
+           /* The parser saw this as a list repeat, and there
+              are probably several items on the stack. But we're
+              in scalar context, and there's no pp_list to save us
+              now. So drop the rest of the items -- robin@kitsite.com
+            */
+           dMARK;
+           SP = MARK;
+       }
        PUSHTARG;
     }
     RETURN;
@@ -1704,6 +1716,12 @@ PP(pp_ge)
 PP(pp_ne)
 {
     dSP; tryAMAGICbinSET(ne,0);
+#ifndef NV_PRESERVES_UV
+    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+       SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
+       RETURN;
+    }
+#endif
 #ifdef PERL_PRESERVE_IVUV
     SvIV_please(TOPs);
     if (SvIOK(TOPs)) {
@@ -1774,6 +1792,12 @@ PP(pp_ne)
 PP(pp_ncmp)
 {
     dSP; dTARGET; tryAMAGICbin(ncmp,0);
+#ifndef NV_PRESERVES_UV
+    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+       SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
+       RETURN;
+    }
+#endif
 #ifdef PERL_PRESERVE_IVUV
     /* Fortunately it seems NaN isn't IOK */
     SvIV_please(TOPs);
@@ -1954,6 +1978,12 @@ PP(pp_sne)
 PP(pp_scmp)
 {
     dSP; dTARGET;  tryAMAGICbin(scmp,0);
+#ifndef NV_PRESERVES_UV
+    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+       SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
+       RETURN;
+    }
+#endif
     {
       dPOPTOPssrl;
       int cmp = ((PL_op->op_private & OPpLOCALE)
@@ -2639,11 +2669,11 @@ PP(pp_hex)
     dSP; dTARGET;
     char *tmps;
     STRLEN argtype;
-    STRLEN n_a;
+    STRLEN len;
 
-    tmps = POPpx;
+    tmps = (SvPVx(POPs, len));
     argtype = 1;               /* allow underscores */
-    XPUSHn(scan_hex(tmps, 99, &argtype));
+    XPUSHn(scan_hex(tmps, len, &argtype));
     RETURN;
 }
 
@@ -2653,20 +2683,20 @@ PP(pp_oct)
     NV value;
     STRLEN argtype;
     char *tmps;
-    STRLEN n_a;
+    STRLEN len;
 
-    tmps = POPpx;
-    while (*tmps && isSPACE(*tmps))
-       tmps++;
+    tmps = (SvPVx(POPs, len));
+    while (*tmps && len && isSPACE(*tmps))
+       tmps++, len--;
     if (*tmps == '0')
-       tmps++;
+       tmps++, len--;
     argtype = 1;               /* allow underscores */
     if (*tmps == 'x')
-       value = scan_hex(++tmps, 99, &argtype);
+       value = scan_hex(++tmps, --len, &argtype);
     else if (*tmps == 'b')
-       value = scan_bin(++tmps, 99, &argtype);
+       value = scan_bin(++tmps, --len, &argtype);
     else
-       value = scan_oct(tmps, 99, &argtype);
+       value = scan_oct(tmps, len, &argtype);
     XPUSHn(value);
     RETURN;
 }
@@ -2691,39 +2721,51 @@ PP(pp_substr)
     SV *sv;
     I32 len;
     STRLEN curlen;
-    STRLEN utfcurlen;
+    STRLEN utf8_curlen;
     I32 pos;
     I32 rem;
     I32 fail;
     I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
     char *tmps;
     I32 arybase = PL_curcop->cop_arybase;
+    SV *repl_sv = NULL;
     char *repl = 0;
     STRLEN repl_len;
     int num_args = PL_op->op_private & 7;
+    bool repl_need_utf8_upgrade = FALSE;
+    bool repl_is_utf8 = FALSE;
 
     SvTAINTED_off(TARG);                       /* decontaminate */
     SvUTF8_off(TARG);                          /* decontaminate */
     if (num_args > 2) {
        if (num_args > 3) {
-           sv = POPs;
-           repl = SvPV(sv, repl_len);
+           repl_sv = POPs;
+           repl = SvPV(repl_sv, repl_len);
+           repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
        }
        len = POPi;
     }
     pos = POPi;
     sv = POPs;
     PUTBACK;
+    if (repl_sv) {
+       if (repl_is_utf8) {
+           if (!DO_UTF8(sv))
+               sv_utf8_upgrade(sv);
+       }
+       else if (DO_UTF8(sv))
+           repl_need_utf8_upgrade = TRUE;
+    }
     tmps = SvPV(sv, curlen);
     if (DO_UTF8(sv)) {
-        utfcurlen = sv_len_utf8(sv);
-       if (utfcurlen == curlen)
-           utfcurlen = 0;
+        utf8_curlen = sv_len_utf8(sv);
+       if (utf8_curlen == curlen)
+           utf8_curlen = 0;
        else
-           curlen = utfcurlen;
+           curlen = utf8_curlen;
     }
     else
-       utfcurlen = 0;
+       utf8_curlen = 0;
 
     if (pos >= arybase) {
        pos -= arybase;
@@ -2768,14 +2810,27 @@ PP(pp_substr)
     else {
        I32 upos = pos;
        I32 urem = rem;
-       if (utfcurlen)
+       if (utf8_curlen)
            sv_pos_u2b(sv, &pos, &rem);
        tmps += pos;
        sv_setpvn(TARG, tmps, rem);
-       if (utfcurlen)
+       if (utf8_curlen)
            SvUTF8_on(TARG);
-       if (repl)
+       if (repl) {
+           SV* repl_sv_copy = NULL;
+
+           if (repl_need_utf8_upgrade) {
+               repl_sv_copy = newSVsv(repl_sv);
+               sv_utf8_upgrade(repl_sv_copy);
+               repl = SvPV(repl_sv_copy, repl_len);
+               repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
+           }
            sv_insert(sv, pos, rem, repl, repl_len);
+           if (repl_is_utf8)
+               SvUTF8_on(sv);
+           if (repl_sv_copy)
+               SvREFCNT_dec(repl_sv_copy);
+       }
        else if (lvalue) {              /* it's an lvalue! */
            if (!SvGMAGICAL(sv)) {
                if (SvROK(sv)) {