Move do_chomp() from pp.c to doop.c, and make it static.
authorNicholas Clark <nick@ccl4.org>
Mon, 27 Dec 2010 12:56:12 +0000 (12:56 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 27 Dec 2010 12:56:12 +0000 (12:56 +0000)
It was never part of the public API, and only ever used by pp_{s,}cho{,m}p.

doop.c
embed.fnc
embed.h
pp.c
proto.h

diff --git a/doop.c b/doop.c
index 716b6c2..717ee66 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -982,173 +982,6 @@ Perl_do_vecset(pTHX_ SV *sv)
     SvSETMAGIC(targ);
 }
 
-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)
 {
index 4cc7641..fd17107 100644 (file)
--- 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 6a375d6..de10dc2 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
 #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 1e2c79f..0713ec6 100644 (file)
--- 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 fe26030..4303678 100644 (file)
--- 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__