Merge Perl_do_chop() and Perl_do_chomp().

They share code for dealing with PVAVs, PVHVs, read only values and handling
PL_encoding. They are not part of the public API, and Google codesearch shows
no users outside the core.

diff --git a/doop.c b/doop.c
index 1b71fe1..716b6c2 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -983,97 +983,15 @@ Perl_do_vecset(pTHX_ SV *sv)
 }
 
 void
-Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
+Perl_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 {
     dVAR;
     STRLEN len;
     char *s;
 
-    PERL_ARGS_ASSERT_DO_CHOP;
-
-    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_chop(astr, sv);
-       }
-        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_chop(astr,hv_iterval(hv,entry));
-        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 && !SvUTF8(sv)) {
-       /* like in do_chomp(), utf8-ize the sv as a side-effect
-        * if we're using encoding. */
-       sv_recode_to_utf8(sv, PL_encoding);
-    }
-
-    s = SvPV(sv, len);
-    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(astr, s, send - s);
-               *s = '\0';
-               SvCUR_set(sv, s - start);
-               SvNIOK_off(sv);
-               SvUTF8_on(astr);
-           }
-       }
-       else
-           sv_setpvs(astr, "");
-    }
-    else if (s && len) {
-       s += --len;
-       sv_setpvn(astr, s, 1);
-       *s = '\0';
-       SvCUR_set(sv, len);
-       SvUTF8_off(sv);
-       SvNIOK_off(sv);
-    }
-    else
-       sv_setpvs(astr, "");
-    SvSETMAGIC(sv);
-}
-
-void
-Perl_do_chomp(pTHX_ SV *count, SV *sv)
-{
-    dVAR;
-    STRLEN len;
-    char *s;
-    char *temp_buffer = NULL;
-    SV* svrecode = NULL;
-
     PERL_ARGS_ASSERT_DO_CHOMP;
 
-    if (RsSNARF(PL_rs))
-       return;
-    if (RsRECORD(PL_rs))
+    if (chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs)))
        return;
     if (SvTYPE(sv) == SVt_PVAV) {
        register I32 i;
@@ -1083,7 +1001,7 @@ Perl_do_chomp(pTHX_ SV *count, SV *sv)
        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(count, sv);
+               do_chomp(retval, sv, chomping);
        }
         return;
     }
@@ -1092,7 +1010,7 @@ Perl_do_chomp(pTHX_ SV *count, SV *sv)
        HE* entry;
         (void)hv_iterinit(hv);
         while ((entry = hv_iternext(hv)))
-            do_chomp(count, hv_iterval(hv,entry));
+            do_chomp(retval, hv_iterval(hv,entry), chomping);
        return;
     }
     else if (SvREADONLY(sv)) {
@@ -1116,16 +1034,20 @@ Perl_do_chomp(pTHX_ SV *count, SV *sv)
     }
 
     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(count);
+           ++SvIVX(retval);
            while (len && s[-1] == '\n') {
                --len;
                --s;
-               ++SvIVX(count);
+               ++SvIVX(retval);
            }
        }
        else {
@@ -1169,7 +1091,7 @@ Perl_do_chomp(pTHX_ SV *count, SV *sv)
            if (rslen == 1) {
                if (*s != *rsptr)
                    goto nope;
-               ++SvIVX(count);
+               ++SvIVX(retval);
            }
            else {
                if (len < rslen - 1)
@@ -1178,7 +1100,7 @@ Perl_do_chomp(pTHX_ SV *count, SV *sv)
                s -= rslen - 1;
                if (memNE(s, rsptr, rslen))
                    goto nope;
-               SvIVX(count) += rs_charlen;
+               SvIVX(retval) += rs_charlen;
            }
        }
        s = SvPV_force_nolen(sv);
@@ -1192,6 +1114,39 @@ Perl_do_chomp(pTHX_ SV *count, SV *sv)
     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

diff --git a/embed.fnc b/embed.fnc
index 88129d7..4cc7641 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -301,7 +301,6 @@ pmb |bool   |do_aexec       |NULLOK SV* really|NN SV** mark|NN SV** sp
 p      |bool   |do_aexec5      |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report
 Ap     |int    |do_binmode     |NN PerlIO *fp|int iotype|int mode
 : Used in pp.c
-p      |void   |do_chop        |NN SV *astr|NN SV *sv
 Ap     |bool   |do_close       |NULLOK GV* gv|bool not_implicit
 : Defined in doio.c, used only in pp_sys.c
 p      |bool   |do_eof         |NN GV* gv
@@ -355,7 +354,7 @@ 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 *count|NN SV *sv
+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

diff --git a/embed.h b/embed.h
index a427ef5..6a375d6 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -974,8 +974,7 @@
 #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)          Perl_do_chomp(aTHX_ a,b)
-#define do_chop(a,b)           Perl_do_chop(aTHX_ a,b)
+#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)

diff --git a/pp.c b/pp.c
index ef325a9..573672d 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -794,7 +794,7 @@ PP(pp_trans)
 PP(pp_schop)
 {
     dVAR; dSP; dTARGET;
-    do_chop(TARG, TOPs);
+    do_chomp(TARG, TOPs, FALSE);
     SETTARG;
     RETURN;
 }
@@ -803,7 +803,7 @@ PP(pp_chop)
 {
     dVAR; dSP; dMARK; dTARGET; dORIGMARK;
     while (MARK < SP)
-       do_chop(TARG, *++MARK);
+       do_chomp(TARG, *++MARK, FALSE);
     SP = ORIGMARK;
     XPUSHTARG;
     RETURN;
@@ -813,7 +813,7 @@ PP(pp_schomp)
 {
     dVAR; dSP; dTARGET;
     sv_setiv(TARG, 0);
-    do_chomp(TARG, TOPs);
+    do_chomp(TARG, TOPs, TRUE);
     SETs(TARG);
     RETURN;
 }
@@ -824,7 +824,7 @@ PP(pp_chomp)
 
     sv_setiv(TARG, 0);
     while (MARK < SP)
-       do_chomp(TARG, *++MARK);
+       do_chomp(TARG, *++MARK, TRUE);
     SP = ORIGMARK;
     XPUSHTARG;
     RETURN;

diff --git a/proto.h b/proto.h
index 1ee666e..fe26030 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -707,17 +707,11 @@ 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 *count, SV *sv)
+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(count); assert(sv)
-
-PERL_CALLCONV void     Perl_do_chop(pTHX_ SV *astr, SV *sv)
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_DO_CHOP       \
-       assert(astr); assert(sv)
+       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)