Move do_chomp() from pp.c to doop.c, and make it static.

It was never part of the public API, and only ever used by pp_{s,}cho{,m}p.

5 files changed, 175 insertions, 176 deletions

diff --git a/doop.c b/doop.c
index 716b6c250c..717ee66280 100644
--- a/doop.c
+++ b/doop.c
@@ -983,173 +983,6 @@ Perl_do_vecset(pTHX_ SV *sv)
 }
 
 void
-Perl_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
-{
-    dVAR;
-    STRLEN len;
-    char *s;
-
-    PERL_ARGS_ASSERT_DO_CHOMP;
-
-    if (chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs)))
-	return;
-    if (SvTYPE(sv) == SVt_PVAV) {
-	register I32 i;
-	AV *const av = MUTABLE_AV(sv);
-	const I32 max = AvFILL(av);
-
-	for (i = 0; i <= max; i++) {
-	    sv = MUTABLE_SV(av_fetch(av, i, FALSE));
-	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
-		do_chomp(retval, sv, chomping);
-	}
-        return;
-    }
-    else if (SvTYPE(sv) == SVt_PVHV) {
-	HV* const hv = MUTABLE_HV(sv);
-	HE* entry;
-        (void)hv_iterinit(hv);
-        while ((entry = hv_iternext(hv)))
-            do_chomp(retval, hv_iterval(hv,entry), chomping);
-	return;
-    }
-    else if (SvREADONLY(sv)) {
-        if (SvFAKE(sv)) {
-            /* SV is copy-on-write */
-	    sv_force_normal_flags(sv, 0);
-        }
-        if (SvREADONLY(sv))
-            Perl_croak_no_modify(aTHX);
-    }
-
-    if (PL_encoding) {
-	if (!SvUTF8(sv)) {
-	/* XXX, here sv is utf8-ized as a side-effect!
-	   If encoding.pm is used properly, almost string-generating
-	   operations, including literal strings, chr(), input data, etc.
-	   should have been utf8-ized already, right?
-	*/
-	    sv_recode_to_utf8(sv, PL_encoding);
-	}
-    }
-
-    s = SvPV(sv, len);
-    if (chomping) {
-	char *temp_buffer = NULL;
-	SV* svrecode = NULL;
-
-    if (s && len) {
-	s += --len;
-	if (RsPARA(PL_rs)) {
-	    if (*s != '\n')
-		goto nope;
-	    ++SvIVX(retval);
-	    while (len && s[-1] == '\n') {
-		--len;
-		--s;
-		++SvIVX(retval);
-	    }
-	}
-	else {
-	    STRLEN rslen, rs_charlen;
-	    const char *rsptr = SvPV_const(PL_rs, rslen);
-
-	    rs_charlen = SvUTF8(PL_rs)
-		? sv_len_utf8(PL_rs)
-		: rslen;
-
-	    if (SvUTF8(PL_rs) != SvUTF8(sv)) {
-		/* Assumption is that rs is shorter than the scalar.  */
-		if (SvUTF8(PL_rs)) {
-		    /* RS is utf8, scalar is 8 bit.  */
-		    bool is_utf8 = TRUE;
-		    temp_buffer = (char*)bytes_from_utf8((U8*)rsptr,
-							 &rslen, &is_utf8);
-		    if (is_utf8) {
-			/* Cannot downgrade, therefore cannot possibly match
-			 */
-			assert (temp_buffer == rsptr);
-			temp_buffer = NULL;
-			goto nope;
-		    }
-		    rsptr = temp_buffer;
-		}
-		else if (PL_encoding) {
-		    /* RS is 8 bit, encoding.pm is used.
-		     * Do not recode PL_rs as a side-effect. */
-		   svrecode = newSVpvn(rsptr, rslen);
-		   sv_recode_to_utf8(svrecode, PL_encoding);
-		   rsptr = SvPV_const(svrecode, rslen);
-		   rs_charlen = sv_len_utf8(svrecode);
-		}
-		else {
-		    /* RS is 8 bit, scalar is utf8.  */
-		    temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen);
-		    rsptr = temp_buffer;
-		}
-	    }
-	    if (rslen == 1) {
-		if (*s != *rsptr)
-		    goto nope;
-		++SvIVX(retval);
-	    }
-	    else {
-		if (len < rslen - 1)
-		    goto nope;
-		len -= rslen - 1;
-		s -= rslen - 1;
-		if (memNE(s, rsptr, rslen))
-		    goto nope;
-		SvIVX(retval) += rs_charlen;
-	    }
-	}
-	s = SvPV_force_nolen(sv);
-	SvCUR_set(sv, len);
-	*SvEND(sv) = '\0';
-	SvNIOK_off(sv);
-	SvSETMAGIC(sv);
-    }
-  nope:
-
-    SvREFCNT_dec(svrecode);
-
-    Safefree(temp_buffer);
-    } else {
-	if (len && !SvPOK(sv))
-	    s = SvPV_force_nomg(sv, len);
-	if (DO_UTF8(sv)) {
-	    if (s && len) {
-		char * const send = s + len;
-		char * const start = s;
-		s = send - 1;
-		while (s > start && UTF8_IS_CONTINUATION(*s))
-		    s--;
-		if (is_utf8_string((U8*)s, send - s)) {
-		    sv_setpvn(retval, s, send - s);
-		    *s = '\0';
-		    SvCUR_set(sv, s - start);
-		    SvNIOK_off(sv);
-		    SvUTF8_on(retval);
-		}
-	    }
-	    else
-		sv_setpvs(retval, "");
-	}
-	else if (s && len) {
-	    s += --len;
-	    sv_setpvn(retval, s, 1);
-	    *s = '\0';
-	    SvCUR_set(sv, len);
-	    SvUTF8_off(sv);
-	    SvNIOK_off(sv);
-	}
-	else
-	    sv_setpvs(retval, "");
-	SvSETMAGIC(sv);
-    }
-}
-
-void
 Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 {
     dVAR;
diff --git a/embed.fnc b/embed.fnc
index 4cc7641109..fd17107f93 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -353,8 +353,6 @@ Ap	|bool	|do_openn	|NN GV *gv|NN const char *oname|I32 len \
 p	|bool	|do_print	|NULLOK SV* sv|NN PerlIO* fp
 : Used in pp_sys.c
 pR	|OP*	|do_readline
-: Used in pp.c
-p	|void	|do_chomp	|NN SV *retval|NN SV *sv|bool chomping
 : Defined in doio.c, used only in pp_sys.c
 p	|bool	|do_seek	|NULLOK GV* gv|Off_t pos|int whence
 Ap	|void	|do_sprintf	|NN SV* sv|I32 len|NN SV** sarg
@@ -1643,6 +1641,7 @@ s	|SV *	|incpush_if_exists|NN AV *const av|NN SV *dir|NN SV *const stem
 #endif
 
 #if defined(PERL_IN_PP_C)
+s	|void	|do_chomp	|NN SV *retval|NN SV *sv|bool chomping
 s	|OP*	|do_delete_local
 sR	|SV*	|refto		|NN SV* sv
 #endif
diff --git a/embed.h b/embed.h
index 6a375d6b1c..de10dc2bbd 100644
--- a/embed.h
+++ b/embed.h
@@ -974,7 +974,6 @@
 #define delete_eval_scope()	Perl_delete_eval_scope(aTHX)
 #define die_unwind(a)		Perl_die_unwind(aTHX_ a)
 #define do_aexec5(a,b,c,d,e)	Perl_do_aexec5(aTHX_ a,b,c,d,e)
-#define do_chomp(a,b,c)		Perl_do_chomp(aTHX_ a,b,c)
 #define do_dump_pad(a,b,c,d)	Perl_do_dump_pad(aTHX_ a,b,c,d)
 #define do_eof(a)		Perl_do_eof(aTHX_ a)
 #define do_execfree()		Perl_do_execfree(aTHX)
@@ -1712,6 +1711,7 @@
 #define usage(a)		S_usage(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_PP_C)
+#define do_chomp(a,b,c)		S_do_chomp(aTHX_ a,b,c)
 #define do_delete_local()	S_do_delete_local(aTHX)
 #define refto(a)		S_refto(aTHX_ a)
 #  endif
diff --git a/pp.c b/pp.c
index 1e2c79f5ed..0713ec6786 100644
--- a/pp.c
+++ b/pp.c
@@ -791,6 +791,173 @@ PP(pp_trans)
 
 /* Lvalue operators. */
 
+static void
+S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
+{
+    dVAR;
+    STRLEN len;
+    char *s;
+
+    PERL_ARGS_ASSERT_DO_CHOMP;
+
+    if (chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs)))
+	return;
+    if (SvTYPE(sv) == SVt_PVAV) {
+	I32 i;
+	AV *const av = MUTABLE_AV(sv);
+	const I32 max = AvFILL(av);
+
+	for (i = 0; i <= max; i++) {
+	    sv = MUTABLE_SV(av_fetch(av, i, FALSE));
+	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
+		do_chomp(retval, sv, chomping);
+	}
+        return;
+    }
+    else if (SvTYPE(sv) == SVt_PVHV) {
+	HV* const hv = MUTABLE_HV(sv);
+	HE* entry;
+        (void)hv_iterinit(hv);
+        while ((entry = hv_iternext(hv)))
+            do_chomp(retval, hv_iterval(hv,entry), chomping);
+	return;
+    }
+    else if (SvREADONLY(sv)) {
+        if (SvFAKE(sv)) {
+            /* SV is copy-on-write */
+	    sv_force_normal_flags(sv, 0);
+        }
+        if (SvREADONLY(sv))
+            Perl_croak_no_modify(aTHX);
+    }
+
+    if (PL_encoding) {
+	if (!SvUTF8(sv)) {
+	    /* XXX, here sv is utf8-ized as a side-effect!
+	       If encoding.pm is used properly, almost string-generating
+	       operations, including literal strings, chr(), input data, etc.
+	       should have been utf8-ized already, right?
+	    */
+	    sv_recode_to_utf8(sv, PL_encoding);
+	}
+    }
+
+    s = SvPV(sv, len);
+    if (chomping) {
+	char *temp_buffer = NULL;
+	SV *svrecode = NULL;
+
+	if (s && len) {
+	    s += --len;
+	    if (RsPARA(PL_rs)) {
+		if (*s != '\n')
+		    goto nope;
+		++SvIVX(retval);
+		while (len && s[-1] == '\n') {
+		    --len;
+		    --s;
+		    ++SvIVX(retval);
+		}
+	    }
+	    else {
+		STRLEN rslen, rs_charlen;
+		const char *rsptr = SvPV_const(PL_rs, rslen);
+
+		rs_charlen = SvUTF8(PL_rs)
+		    ? sv_len_utf8(PL_rs)
+		    : rslen;
+
+		if (SvUTF8(PL_rs) != SvUTF8(sv)) {
+		    /* Assumption is that rs is shorter than the scalar.  */
+		    if (SvUTF8(PL_rs)) {
+			/* RS is utf8, scalar is 8 bit.  */
+			bool is_utf8 = TRUE;
+			temp_buffer = (char*)bytes_from_utf8((U8*)rsptr,
+							     &rslen, &is_utf8);
+			if (is_utf8) {
+			    /* Cannot downgrade, therefore cannot possibly match
+			     */
+			    assert (temp_buffer == rsptr);
+			    temp_buffer = NULL;
+			    goto nope;
+			}
+			rsptr = temp_buffer;
+		    }
+		    else if (PL_encoding) {
+			/* RS is 8 bit, encoding.pm is used.
+			 * Do not recode PL_rs as a side-effect. */
+			svrecode = newSVpvn(rsptr, rslen);
+			sv_recode_to_utf8(svrecode, PL_encoding);
+			rsptr = SvPV_const(svrecode, rslen);
+			rs_charlen = sv_len_utf8(svrecode);
+		    }
+		    else {
+			/* RS is 8 bit, scalar is utf8.  */
+			temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen);
+			rsptr = temp_buffer;
+		    }
+		}
+		if (rslen == 1) {
+		    if (*s != *rsptr)
+			goto nope;
+		    ++SvIVX(retval);
+		}
+		else {
+		    if (len < rslen - 1)
+			goto nope;
+		    len -= rslen - 1;
+		    s -= rslen - 1;
+		    if (memNE(s, rsptr, rslen))
+			goto nope;
+		    SvIVX(retval) += rs_charlen;
+		}
+	    }
+	    s = SvPV_force_nolen(sv);
+	    SvCUR_set(sv, len);
+	    *SvEND(sv) = '\0';
+	    SvNIOK_off(sv);
+	    SvSETMAGIC(sv);
+	}
+    nope:
+
+	SvREFCNT_dec(svrecode);
+
+	Safefree(temp_buffer);
+    } else {
+	if (len && !SvPOK(sv))
+	    s = SvPV_force_nomg(sv, len);
+	if (DO_UTF8(sv)) {
+	    if (s && len) {
+		char * const send = s + len;
+		char * const start = s;
+		s = send - 1;
+		while (s > start && UTF8_IS_CONTINUATION(*s))
+		    s--;
+		if (is_utf8_string((U8*)s, send - s)) {
+		    sv_setpvn(retval, s, send - s);
+		    *s = '\0';
+		    SvCUR_set(sv, s - start);
+		    SvNIOK_off(sv);
+		    SvUTF8_on(retval);
+		}
+	    }
+	    else
+		sv_setpvs(retval, "");
+	}
+	else if (s && len) {
+	    s += --len;
+	    sv_setpvn(retval, s, 1);
+	    *s = '\0';
+	    SvCUR_set(sv, len);
+	    SvUTF8_off(sv);
+	    SvNIOK_off(sv);
+	}
+	else
+	    sv_setpvs(retval, "");
+	SvSETMAGIC(sv);
+    }
+}
+
 PP(pp_schop)
 {
     dVAR; dSP; dTARGET;
diff --git a/proto.h b/proto.h
index fe2603092f..430367835b 100644
--- a/proto.h
+++ b/proto.h
@@ -707,12 +707,6 @@ PERL_CALLCONV int	Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 #define PERL_ARGS_ASSERT_DO_BINMODE	\
 	assert(fp)
 
-PERL_CALLCONV void	Perl_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
-			__attribute__nonnull__(pTHX_1)
-			__attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_DO_CHOMP	\
-	assert(retval); assert(sv)
-
 PERL_CALLCONV bool	Perl_do_close(pTHX_ GV* gv, bool not_implicit);
 PERL_CALLCONV void	Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 			__attribute__nonnull__(pTHX_2);
@@ -5969,6 +5963,12 @@ STATIC void	S_usage(pTHX_ const char *name)
 
 #endif
 #if defined(PERL_IN_PP_C)
+STATIC void	S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_DO_CHOMP	\
+	assert(retval); assert(sv)
+
 STATIC OP*	S_do_delete_local(pTHX);
 STATIC SV*	S_refto(pTHX_ SV* sv)
 			__attribute__warn_unused_result__