The last parameter to gv_stashpv/gv_stashpvn/gv_stashsv is a bitmask

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 25a7004..e1a45c1 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1,7 +1,7 @@
 /*    pp.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -222,6 +222,50 @@ PP(pp_rv2gv)
     RETURN;
 }
 
+/* Helper function for pp_rv2sv and pp_rv2av  */
+GV *
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
+               SV ***spp)
+{
+    dVAR;
+    GV *gv;
+
+    if (PL_op->op_private & HINT_STRICT_REFS) {
+       if (SvOK(sv))
+           Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+       else
+           Perl_die(aTHX_ PL_no_usym, what);
+    }
+    if (!SvOK(sv)) {
+       if (PL_op->op_flags & OPf_REF)
+           Perl_die(aTHX_ PL_no_usym, what);
+       if (ckWARN(WARN_UNINITIALIZED))
+           report_uninit(sv);
+       if (type != SVt_PV && GIMME_V == G_ARRAY) {
+           (*spp)--;
+           return NULL;
+       }
+       **spp = &PL_sv_undef;
+       return NULL;
+    }
+    if ((PL_op->op_flags & OPf_SPECIAL) &&
+       !(PL_op->op_flags & OPf_MOD))
+       {
+           gv = (GV*)gv_fetchsv(sv, 0, type);
+           if (!gv
+               && (!is_gv_magical_sv(sv,0)
+                   || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
+               {
+                   **spp = &PL_sv_undef;
+                   return NULL;
+               }
+       }
+    else {
+       gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
+    }
+    return gv;
+}
+
 PP(pp_rv2sv)
 {
     dVAR; dSP; dTOPss;
@@ -251,33 +295,9 @@ PP(pp_rv2sv)
                if (SvROK(sv))
                    goto wasref;
            }
-           if (PL_op->op_private & HINT_STRICT_REFS) {
-               if (SvOK(sv))
-                   DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR");
-               else
-                   DIE(aTHX_ PL_no_usym, "a SCALAR");
-           }
-           if (!SvOK(sv)) {
-               if (PL_op->op_flags & OPf_REF)
-                   DIE(aTHX_ PL_no_usym, "a SCALAR");
-               if (ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-               RETSETUNDEF;
-           }
-           if ((PL_op->op_flags & OPf_SPECIAL) &&
-               !(PL_op->op_flags & OPf_MOD))
-           {
-               gv = (GV*)gv_fetchsv(sv, 0, SVt_PV);
-               if (!gv
-                   && (!is_gv_magical_sv(sv, 0)
-                       || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV))))
-               {
-                   RETSETUNDEF;
-               }
-           }
-           else {
-               gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV);
-           }
+           gv = Perl_softref2xv(aTHX_ sv, "a SCALAR", SVt_PV, &sp);
+           if (!gv)
+               RETURN;
        }
        sv = GvSVn(gv);
     }
@@ -558,7 +578,7 @@ PP(pp_bless)
        if (len == 0 && ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                   "Explicit blessing to '' (assuming package main)");
-       stash = gv_stashpvn(ptr, len, TRUE);
+       stash = gv_stashpvn(ptr, len, GV_ADD);
     }
 
     (void)sv_bless(TOPs, stash);
@@ -4590,7 +4610,11 @@ PP(pp_split)
     base = SP - PL_stack_base;
     orig = s;
     if (pm->op_pmflags & PMf_SKIPWHITE) {
-       if (pm->op_pmflags & PMf_LOCALE) {
+       if (do_utf8) {
+           while (*s == ' ' || is_utf8_space((U8*)s))
+               s += UTF8SKIP(s);
+       }
+       else if (pm->op_pmflags & PMf_LOCALE) {
            while (isSPACE_LC(*s))
                s++;
        }
@@ -4608,10 +4632,23 @@ PP(pp_split)
     if (pm->op_pmflags & PMf_WHITE) {
        while (--limit) {
            m = s;
-           while (m < strend &&
-                  !((pm->op_pmflags & PMf_LOCALE)
-                    ? isSPACE_LC(*m) : isSPACE(*m)))
-               ++m;
+           /* this one uses 'm' and is a negative test */
+           if (do_utf8) {
+               while (m < strend && !( *m == ' ' || is_utf8_space((U8*)m) )) {
+                   const int t = UTF8SKIP(m);
+                   /* is_utf8_space returns FALSE for malform utf8 */
+                   if (strend - m < t)
+                       m = strend;
+                   else
+                       m += t;
+               }
+            } else if (pm->op_pmflags & PMf_LOCALE) {
+               while (m < strend && !isSPACE_LC(*m))
+                   ++m;
+            } else {
+                while (m < strend && !isSPACE(*m))
+                    ++m;
+            }  
            if (m >= strend)
                break;
 
@@ -4622,14 +4659,26 @@ PP(pp_split)
                (void)SvUTF8_on(dstr);
            XPUSHs(dstr);
 
-           s = m + 1;
-           while (s < strend &&
-                  ((pm->op_pmflags & PMf_LOCALE)
-                   ? isSPACE_LC(*s) : isSPACE(*s)))
-               ++s;
+           /* skip the whitespace found last */
+           if (do_utf8)
+               s = m + UTF8SKIP(m);
+           else
+               s = m + 1;
+
+           /* this one uses 's' and is a positive test */
+           if (do_utf8) {
+               while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
+                   s +=  UTF8SKIP(s);
+            } else if (pm->op_pmflags & PMf_LOCALE) {
+               while (s < strend && isSPACE_LC(*s))
+                   ++s;
+            } else {
+                while (s < strend && isSPACE(*s))
+                    ++s;
+            }      
        }
     }
-    else if (rx->precomp[0] == '^' && rx->precomp[1] == '\0') {
+    else if (rx->extflags & RXf_START_ONLY) {
        while (--limit) {
            for (m = s; m < strend && *m != '\n'; m++)
                ;