X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=e1a45c1a42ebc0289a26c3f8dd5131706825843b;hb=798b63bc924a07589315b3229311582adce06136;hp=450589045d71e6fb48c9cffd3ae01e8a36e5f1b9;hpb=fdf8c08824a2cd37d9fab91f3056bff4358cb60b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 4505890..e1a45c1 100644
--- a/pp.c
+++ b/pp.c
@@ -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++)
 		;