X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=4e6d930ed215c9f0ae0852236d7329b82d250777;hb=ca9279baf07d6843f58a31f1ce3ff7dc875faf1a;hp=05e999b7cccf6d39ce7956880fd87d5c5c0ce849;hpb=58f1856e573b4625770ae64ce5ffb8ff06dc461f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 05e999b..4e6d930 100644
--- a/sv.c
+++ b/sv.c
@@ -3080,7 +3080,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		}
 		tsv = NEWSV(0,0);
 		if (SvOBJECT(sv))
-		    Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+		    if (HvNAME(SvSTASH(sv)))
+			Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+		    else
+			Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s);
 		else
 		    sv_setpv(tsv, s);
 		Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
@@ -4498,6 +4501,8 @@ Efficient removal of characters from the beginning of the string buffer.
 SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
 the string buffer.  The C<ptr> becomes the first character of the adjusted
 string. Uses the "OOK hack".
+Beware: after this function returns, C<ptr> and SvPVX(sv) may no longer
+refer to the same chunk of data.
 
 =cut
 */
@@ -4506,9 +4511,9 @@ void
 Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
 {
     register STRLEN delta;
-
     if (!ptr || !SvPOKp(sv))
 	return;
+    delta = ptr - SvPVX(sv);
     SV_CHECK_THINKFIRST(sv);
     if (SvTYPE(sv) < SVt_PVIV)
 	sv_upgrade(sv,SVt_PVIV);
@@ -4528,7 +4533,6 @@ Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
 	SvFLAGS(sv) |= SVf_OOK; 
     }
     SvNIOK_off(sv);
-    delta = ptr - SvPVX(sv);
     SvLEN(sv) -= delta;
     SvCUR(sv) -= delta;
     SvPVX(sv) += delta;
@@ -5914,13 +5918,13 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
 	    mg = mg_find(sv, PERL_MAGIC_utf8);
 	    if (mg && mg->mg_ptr) {
 		cache = (STRLEN *) mg->mg_ptr;
-		if (cache[1] == *offsetp) {
+		if (cache[1] == (STRLEN)*offsetp) {
                     /* An exact match. */
                     *offsetp = cache[0];
 
 		    return;
 		}
-		else if (cache[1] < *offsetp) {
+		else if (cache[1] < (STRLEN)*offsetp) {
 		    /* We already know part of the way. */
 		    len = cache[0];
 		    s  += cache[1];
@@ -5943,13 +5947,15 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
 
 			while (backw--) {
 			    p--;
-			    while (UTF8_IS_CONTINUATION(*p))
+			    while (UTF8_IS_CONTINUATION(*p)) {
 				p--;
+				backw--;
+			    }
 			    ubackw++;
 			}
 
 			cache[0] -= ubackw;
-
+			*offsetp = cache[0];
 			return;
 		    }
 		}
@@ -7773,7 +7779,10 @@ char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
     if (ob && SvOBJECT(sv)) {
-	return HvNAME(SvSTASH(sv));
+	if (HvNAME(SvSTASH(sv)))
+	    return HvNAME(SvSTASH(sv));
+	else
+	    return "__ANON__";
     }
     else {
 	switch (SvTYPE(sv)) {
@@ -7851,6 +7860,8 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name)
     sv = (SV*)SvRV(sv);
     if (!SvOBJECT(sv))
 	return 0;
+    if (!HvNAME(SvSTASH(sv)))
+	return 0;
 
     return strEQ(HvNAME(SvSTASH(sv)), name);
 }
@@ -9318,6 +9329,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	     p = SvEND(sv);
 	     *p = '\0';
 	}
+	/* Use memchr() instead of strchr(), as eptr is not guaranteed */
+	/* to point to a null-terminated string.                       */
+	if (left && ckWARN(WARN_PRINTF) && memchr(eptr, '\n', elen) && 
+	    (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) 
+	    Perl_warner(aTHX_ packWARN(WARN_PRINTF),
+		"Newline in left-justified string for %sprintf",
+			(PL_op->op_type == OP_PRTF) ? "" : "s");
 	
 	have = esignlen + zeros + elen;
 	need = (have > width ? have : width);
@@ -11217,6 +11235,19 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
      * but do it for consistency's sake. */
     PL_reentrant_retint	= proto_perl->Ireentrant_retint;
 
+    /* Hooks to shared SVs and locks. */
+    PL_sharehook	= proto_perl->Isharehook;
+    PL_lockhook		= proto_perl->Ilockhook;
+    PL_unlockhook	= proto_perl->Iunlockhook;
+    PL_threadhook	= proto_perl->Ithreadhook;
+
+    PL_runops_std	= proto_perl->Irunops_std;
+    PL_runops_dbg	= proto_perl->Irunops_dbg;
+
+#ifdef THREADS_HAVE_PIDS
+    PL_ppid		= proto_perl->Ippid;
+#endif
+
     /* swatch cache */
     PL_last_swash_hv	= Nullhv;	/* reinits on demand */
     PL_last_swash_klen	= 0;